{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DerivingVia       #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE Strict            #-}
module Language.Cimple.Ast
    ( AssignOp (..)
    , BinaryOp (..)
    , UnaryOp (..)
    , LiteralType (..)
    , Node, NodeF (..)
    , Scope (..)
    , CommentStyle (..)
    , Comment
    , CommentF (..)
    , Nullability (..)
    , getNodeId
    ) where

import           Data.Aeson                   (FromJSON, FromJSON1, ToJSON,
                                               ToJSON1)
import           Data.Fix                     (Fix (..))
import           Data.Functor.Classes         (Eq1, Ord1, Read1, Show1)
import           Data.Functor.Classes.Generic (FunctorClassesDefault (..))
import           Data.Hashable                (Hashable (..))
import           Data.Hashable.Lifted         (Hashable1)
import           GHC.Generics                 (Generic, Generic1)

getNodeId :: Hashable a => Node a -> Int
getNodeId :: Node a -> Int
getNodeId = Node a -> Int
forall a. Hashable a => a -> Int
hash

data NodeF lexeme a
    -- Preprocessor
    = PreprocInclude lexeme
    | PreprocDefine lexeme
    | PreprocDefineConst lexeme a
    | PreprocDefineMacro lexeme [a] a
    | PreprocIf a [a] a
    | PreprocIfdef lexeme [a] a
    | PreprocIfndef lexeme [a] a
    | PreprocElse [a]
    | PreprocElif a [a] a
    | PreprocUndef lexeme
    | PreprocDefined lexeme
    | PreprocScopedDefine a [a] a
    | MacroBodyStmt a
    | MacroBodyFunCall a
    | MacroParam lexeme
    | StaticAssert a lexeme
    -- Comments
    | LicenseDecl lexeme [a]
    | CopyrightDecl lexeme (Maybe lexeme) [lexeme]
    | Comment CommentStyle lexeme [lexeme] lexeme
    | CommentSection a [a] a
    | CommentSectionEnd lexeme
    | Commented a a
    | CommentInfo (Comment lexeme)
    -- Namespace-like blocks
    | ExternC [a]
    -- An inferred coherent block of nodes, printed without empty lines
    -- between them.
    | Group [a]
    -- Statements
    | CompoundStmt [a]
    | Break
    | Goto lexeme
    | Continue
    | Return (Maybe a)
    | SwitchStmt a [a]
    | IfStmt a a (Maybe a)
    | ForStmt a a a a
    | WhileStmt a a
    | DoWhileStmt a a
    | Case a a
    | Default a
    | Label lexeme a
    | ExprStmt a
    -- Variable declarations
    | VLA a lexeme a
    | VarDeclStmt a (Maybe a)
    | VarDecl a lexeme [a]
    | DeclSpecArray (Maybe a)
    | ArrayDim Nullability a
    -- Expressions
    | InitialiserList [a]
    | UnaryExpr UnaryOp a
    | BinaryExpr a BinaryOp a
    | TernaryExpr a a a
    | AssignExpr a AssignOp a
    | ParenExpr a
    | CastExpr a a
    | CompoundExpr a a -- DEPRECATED
    | CompoundLiteral a a
    | SizeofExpr a
    | SizeofType a
    | LiteralExpr LiteralType lexeme
    | VarExpr lexeme
    | MemberAccess a lexeme
    | PointerAccess a lexeme
    | ArrayAccess a a
    | FunctionCall a [a]
    | CommentExpr a a
    -- Type definitions
    | EnumConsts (Maybe lexeme) [a]
    | EnumDecl lexeme [a] lexeme
    | Enumerator lexeme (Maybe a)
    | AggregateDecl a
    | Typedef a lexeme
    | TypedefFunction a
    | Struct lexeme [a]
    | Union lexeme [a]
    | MemberDecl a (Maybe lexeme)
    | TyBitwise a
    | TyForce a
    | TyConst a
    | TyOwner a
    | TyNonnull a
    | TyNullable a
    | TyPointer a
    | TyStruct lexeme
    | TyUnion lexeme
    | TyFunc lexeme
    | TyStd lexeme
    | TyUserDefined lexeme
    -- Functions
    | AttrPrintf lexeme lexeme a
    | FunctionDecl Scope a
    | FunctionDefn Scope a a
    | FunctionPrototype a lexeme [a]
    | CallbackDecl lexeme lexeme
    | Ellipsis
    | NonNull [lexeme] [lexeme] a
    | NonNullParam a
    | NullableParam a
    -- Constants
    | ConstDecl a lexeme
    | ConstDefn Scope a lexeme a
    deriving (Int -> NodeF lexeme a -> ShowS
[NodeF lexeme a] -> ShowS
NodeF lexeme a -> String
(Int -> NodeF lexeme a -> ShowS)
-> (NodeF lexeme a -> String)
-> ([NodeF lexeme a] -> ShowS)
-> Show (NodeF lexeme a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall lexeme a.
(Show lexeme, Show a) =>
Int -> NodeF lexeme a -> ShowS
forall lexeme a. (Show lexeme, Show a) => [NodeF lexeme a] -> ShowS
forall lexeme a. (Show lexeme, Show a) => NodeF lexeme a -> String
showList :: [NodeF lexeme a] -> ShowS
$cshowList :: forall lexeme a. (Show lexeme, Show a) => [NodeF lexeme a] -> ShowS
show :: NodeF lexeme a -> String
$cshow :: forall lexeme a. (Show lexeme, Show a) => NodeF lexeme a -> String
showsPrec :: Int -> NodeF lexeme a -> ShowS
$cshowsPrec :: forall lexeme a.
(Show lexeme, Show a) =>
Int -> NodeF lexeme a -> ShowS
Show, ReadPrec [NodeF lexeme a]
ReadPrec (NodeF lexeme a)
Int -> ReadS (NodeF lexeme a)
ReadS [NodeF lexeme a]
(Int -> ReadS (NodeF lexeme a))
-> ReadS [NodeF lexeme a]
-> ReadPrec (NodeF lexeme a)
-> ReadPrec [NodeF lexeme a]
-> Read (NodeF lexeme a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall lexeme a. (Read lexeme, Read a) => ReadPrec [NodeF lexeme a]
forall lexeme a. (Read lexeme, Read a) => ReadPrec (NodeF lexeme a)
forall lexeme a.
(Read lexeme, Read a) =>
Int -> ReadS (NodeF lexeme a)
forall lexeme a. (Read lexeme, Read a) => ReadS [NodeF lexeme a]
readListPrec :: ReadPrec [NodeF lexeme a]
$creadListPrec :: forall lexeme a. (Read lexeme, Read a) => ReadPrec [NodeF lexeme a]
readPrec :: ReadPrec (NodeF lexeme a)
$creadPrec :: forall lexeme a. (Read lexeme, Read a) => ReadPrec (NodeF lexeme a)
readList :: ReadS [NodeF lexeme a]
$creadList :: forall lexeme a. (Read lexeme, Read a) => ReadS [NodeF lexeme a]
readsPrec :: Int -> ReadS (NodeF lexeme a)
$creadsPrec :: forall lexeme a.
(Read lexeme, Read a) =>
Int -> ReadS (NodeF lexeme a)
Read, NodeF lexeme a -> NodeF lexeme a -> Bool
(NodeF lexeme a -> NodeF lexeme a -> Bool)
-> (NodeF lexeme a -> NodeF lexeme a -> Bool)
-> Eq (NodeF lexeme a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall lexeme a.
(Eq lexeme, Eq a) =>
NodeF lexeme a -> NodeF lexeme a -> Bool
/= :: NodeF lexeme a -> NodeF lexeme a -> Bool
$c/= :: forall lexeme a.
(Eq lexeme, Eq a) =>
NodeF lexeme a -> NodeF lexeme a -> Bool
== :: NodeF lexeme a -> NodeF lexeme a -> Bool
$c== :: forall lexeme a.
(Eq lexeme, Eq a) =>
NodeF lexeme a -> NodeF lexeme a -> Bool
Eq, Eq (NodeF lexeme a)
Eq (NodeF lexeme a)
-> (NodeF lexeme a -> NodeF lexeme a -> Ordering)
-> (NodeF lexeme a -> NodeF lexeme a -> Bool)
-> (NodeF lexeme a -> NodeF lexeme a -> Bool)
-> (NodeF lexeme a -> NodeF lexeme a -> Bool)
-> (NodeF lexeme a -> NodeF lexeme a -> Bool)
-> (NodeF lexeme a -> NodeF lexeme a -> NodeF lexeme a)
-> (NodeF lexeme a -> NodeF lexeme a -> NodeF lexeme a)
-> Ord (NodeF lexeme a)
NodeF lexeme a -> NodeF lexeme a -> Bool
NodeF lexeme a -> NodeF lexeme a -> Ordering
NodeF lexeme a -> NodeF lexeme a -> NodeF lexeme a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall lexeme a. (Ord lexeme, Ord a) => Eq (NodeF lexeme a)
forall lexeme a.
(Ord lexeme, Ord a) =>
NodeF lexeme a -> NodeF lexeme a -> Bool
forall lexeme a.
(Ord lexeme, Ord a) =>
NodeF lexeme a -> NodeF lexeme a -> Ordering
forall lexeme a.
(Ord lexeme, Ord a) =>
NodeF lexeme a -> NodeF lexeme a -> NodeF lexeme a
min :: NodeF lexeme a -> NodeF lexeme a -> NodeF lexeme a
$cmin :: forall lexeme a.
(Ord lexeme, Ord a) =>
NodeF lexeme a -> NodeF lexeme a -> NodeF lexeme a
max :: NodeF lexeme a -> NodeF lexeme a -> NodeF lexeme a
$cmax :: forall lexeme a.
(Ord lexeme, Ord a) =>
NodeF lexeme a -> NodeF lexeme a -> NodeF lexeme a
>= :: NodeF lexeme a -> NodeF lexeme a -> Bool
$c>= :: forall lexeme a.
(Ord lexeme, Ord a) =>
NodeF lexeme a -> NodeF lexeme a -> Bool
> :: NodeF lexeme a -> NodeF lexeme a -> Bool
$c> :: forall lexeme a.
(Ord lexeme, Ord a) =>
NodeF lexeme a -> NodeF lexeme a -> Bool
<= :: NodeF lexeme a -> NodeF lexeme a -> Bool
$c<= :: forall lexeme a.
(Ord lexeme, Ord a) =>
NodeF lexeme a -> NodeF lexeme a -> Bool
< :: NodeF lexeme a -> NodeF lexeme a -> Bool
$c< :: forall lexeme a.
(Ord lexeme, Ord a) =>
NodeF lexeme a -> NodeF lexeme a -> Bool
compare :: NodeF lexeme a -> NodeF lexeme a -> Ordering
$ccompare :: forall lexeme a.
(Ord lexeme, Ord a) =>
NodeF lexeme a -> NodeF lexeme a -> Ordering
$cp1Ord :: forall lexeme a. (Ord lexeme, Ord a) => Eq (NodeF lexeme a)
Ord, (forall x. NodeF lexeme a -> Rep (NodeF lexeme a) x)
-> (forall x. Rep (NodeF lexeme a) x -> NodeF lexeme a)
-> Generic (NodeF lexeme a)
forall x. Rep (NodeF lexeme a) x -> NodeF lexeme a
forall x. NodeF lexeme a -> Rep (NodeF lexeme a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall lexeme a x. Rep (NodeF lexeme a) x -> NodeF lexeme a
forall lexeme a x. NodeF lexeme a -> Rep (NodeF lexeme a) x
$cto :: forall lexeme a x. Rep (NodeF lexeme a) x -> NodeF lexeme a
$cfrom :: forall lexeme a x. NodeF lexeme a -> Rep (NodeF lexeme a) x
Generic, (forall a. NodeF lexeme a -> Rep1 (NodeF lexeme) a)
-> (forall a. Rep1 (NodeF lexeme) a -> NodeF lexeme a)
-> Generic1 (NodeF lexeme)
forall a. Rep1 (NodeF lexeme) a -> NodeF lexeme a
forall a. NodeF lexeme a -> Rep1 (NodeF lexeme) a
forall lexeme a. Rep1 (NodeF lexeme) a -> NodeF lexeme a
forall lexeme a. NodeF lexeme a -> Rep1 (NodeF lexeme) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall lexeme a. Rep1 (NodeF lexeme) a -> NodeF lexeme a
$cfrom1 :: forall lexeme a. NodeF lexeme a -> Rep1 (NodeF lexeme) a
Generic1, a -> NodeF lexeme b -> NodeF lexeme a
(a -> b) -> NodeF lexeme a -> NodeF lexeme b
(forall a b. (a -> b) -> NodeF lexeme a -> NodeF lexeme b)
-> (forall a b. a -> NodeF lexeme b -> NodeF lexeme a)
-> Functor (NodeF lexeme)
forall a b. a -> NodeF lexeme b -> NodeF lexeme a
forall a b. (a -> b) -> NodeF lexeme a -> NodeF lexeme b
forall lexeme a b. a -> NodeF lexeme b -> NodeF lexeme a
forall lexeme a b. (a -> b) -> NodeF lexeme a -> NodeF lexeme b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> NodeF lexeme b -> NodeF lexeme a
$c<$ :: forall lexeme a b. a -> NodeF lexeme b -> NodeF lexeme a
fmap :: (a -> b) -> NodeF lexeme a -> NodeF lexeme b
$cfmap :: forall lexeme a b. (a -> b) -> NodeF lexeme a -> NodeF lexeme b
Functor, NodeF lexeme a -> Bool
(a -> m) -> NodeF lexeme a -> m
(a -> b -> b) -> b -> NodeF lexeme a -> b
(forall m. Monoid m => NodeF lexeme m -> m)
-> (forall m a. Monoid m => (a -> m) -> NodeF lexeme a -> m)
-> (forall m a. Monoid m => (a -> m) -> NodeF lexeme a -> m)
-> (forall a b. (a -> b -> b) -> b -> NodeF lexeme a -> b)
-> (forall a b. (a -> b -> b) -> b -> NodeF lexeme a -> b)
-> (forall b a. (b -> a -> b) -> b -> NodeF lexeme a -> b)
-> (forall b a. (b -> a -> b) -> b -> NodeF lexeme a -> b)
-> (forall a. (a -> a -> a) -> NodeF lexeme a -> a)
-> (forall a. (a -> a -> a) -> NodeF lexeme a -> a)
-> (forall a. NodeF lexeme a -> [a])
-> (forall a. NodeF lexeme a -> Bool)
-> (forall a. NodeF lexeme a -> Int)
-> (forall a. Eq a => a -> NodeF lexeme a -> Bool)
-> (forall a. Ord a => NodeF lexeme a -> a)
-> (forall a. Ord a => NodeF lexeme a -> a)
-> (forall a. Num a => NodeF lexeme a -> a)
-> (forall a. Num a => NodeF lexeme a -> a)
-> Foldable (NodeF lexeme)
forall a. Eq a => a -> NodeF lexeme a -> Bool
forall a. Num a => NodeF lexeme a -> a
forall a. Ord a => NodeF lexeme a -> a
forall m. Monoid m => NodeF lexeme m -> m
forall a. NodeF lexeme a -> Bool
forall a. NodeF lexeme a -> Int
forall a. NodeF lexeme a -> [a]
forall a. (a -> a -> a) -> NodeF lexeme a -> a
forall lexeme a. Eq a => a -> NodeF lexeme a -> Bool
forall lexeme a. Num a => NodeF lexeme a -> a
forall lexeme a. Ord a => NodeF lexeme a -> a
forall m a. Monoid m => (a -> m) -> NodeF lexeme a -> m
forall lexeme m. Monoid m => NodeF lexeme m -> m
forall lexeme a. NodeF lexeme a -> Bool
forall lexeme a. NodeF lexeme a -> Int
forall lexeme a. NodeF lexeme a -> [a]
forall b a. (b -> a -> b) -> b -> NodeF lexeme a -> b
forall a b. (a -> b -> b) -> b -> NodeF lexeme a -> b
forall lexeme a. (a -> a -> a) -> NodeF lexeme a -> a
forall lexeme m a. Monoid m => (a -> m) -> NodeF lexeme a -> m
forall lexeme b a. (b -> a -> b) -> b -> NodeF lexeme a -> b
forall lexeme a b. (a -> b -> b) -> b -> NodeF lexeme 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 :: NodeF lexeme a -> a
$cproduct :: forall lexeme a. Num a => NodeF lexeme a -> a
sum :: NodeF lexeme a -> a
$csum :: forall lexeme a. Num a => NodeF lexeme a -> a
minimum :: NodeF lexeme a -> a
$cminimum :: forall lexeme a. Ord a => NodeF lexeme a -> a
maximum :: NodeF lexeme a -> a
$cmaximum :: forall lexeme a. Ord a => NodeF lexeme a -> a
elem :: a -> NodeF lexeme a -> Bool
$celem :: forall lexeme a. Eq a => a -> NodeF lexeme a -> Bool
length :: NodeF lexeme a -> Int
$clength :: forall lexeme a. NodeF lexeme a -> Int
null :: NodeF lexeme a -> Bool
$cnull :: forall lexeme a. NodeF lexeme a -> Bool
toList :: NodeF lexeme a -> [a]
$ctoList :: forall lexeme a. NodeF lexeme a -> [a]
foldl1 :: (a -> a -> a) -> NodeF lexeme a -> a
$cfoldl1 :: forall lexeme a. (a -> a -> a) -> NodeF lexeme a -> a
foldr1 :: (a -> a -> a) -> NodeF lexeme a -> a
$cfoldr1 :: forall lexeme a. (a -> a -> a) -> NodeF lexeme a -> a
foldl' :: (b -> a -> b) -> b -> NodeF lexeme a -> b
$cfoldl' :: forall lexeme b a. (b -> a -> b) -> b -> NodeF lexeme a -> b
foldl :: (b -> a -> b) -> b -> NodeF lexeme a -> b
$cfoldl :: forall lexeme b a. (b -> a -> b) -> b -> NodeF lexeme a -> b
foldr' :: (a -> b -> b) -> b -> NodeF lexeme a -> b
$cfoldr' :: forall lexeme a b. (a -> b -> b) -> b -> NodeF lexeme a -> b
foldr :: (a -> b -> b) -> b -> NodeF lexeme a -> b
$cfoldr :: forall lexeme a b. (a -> b -> b) -> b -> NodeF lexeme a -> b
foldMap' :: (a -> m) -> NodeF lexeme a -> m
$cfoldMap' :: forall lexeme m a. Monoid m => (a -> m) -> NodeF lexeme a -> m
foldMap :: (a -> m) -> NodeF lexeme a -> m
$cfoldMap :: forall lexeme m a. Monoid m => (a -> m) -> NodeF lexeme a -> m
fold :: NodeF lexeme m -> m
$cfold :: forall lexeme m. Monoid m => NodeF lexeme m -> m
Foldable, Functor (NodeF lexeme)
Foldable (NodeF lexeme)
Functor (NodeF lexeme)
-> Foldable (NodeF lexeme)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> NodeF lexeme a -> f (NodeF lexeme b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    NodeF lexeme (f a) -> f (NodeF lexeme a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> NodeF lexeme a -> m (NodeF lexeme b))
-> (forall (m :: * -> *) a.
    Monad m =>
    NodeF lexeme (m a) -> m (NodeF lexeme a))
-> Traversable (NodeF lexeme)
(a -> f b) -> NodeF lexeme a -> f (NodeF lexeme b)
forall lexeme. Functor (NodeF lexeme)
forall lexeme. Foldable (NodeF lexeme)
forall lexeme (m :: * -> *) a.
Monad m =>
NodeF lexeme (m a) -> m (NodeF lexeme a)
forall lexeme (f :: * -> *) a.
Applicative f =>
NodeF lexeme (f a) -> f (NodeF lexeme a)
forall lexeme (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NodeF lexeme a -> m (NodeF lexeme b)
forall lexeme (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NodeF lexeme a -> f (NodeF lexeme 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 =>
NodeF lexeme (m a) -> m (NodeF lexeme a)
forall (f :: * -> *) a.
Applicative f =>
NodeF lexeme (f a) -> f (NodeF lexeme a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NodeF lexeme a -> m (NodeF lexeme b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NodeF lexeme a -> f (NodeF lexeme b)
sequence :: NodeF lexeme (m a) -> m (NodeF lexeme a)
$csequence :: forall lexeme (m :: * -> *) a.
Monad m =>
NodeF lexeme (m a) -> m (NodeF lexeme a)
mapM :: (a -> m b) -> NodeF lexeme a -> m (NodeF lexeme b)
$cmapM :: forall lexeme (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NodeF lexeme a -> m (NodeF lexeme b)
sequenceA :: NodeF lexeme (f a) -> f (NodeF lexeme a)
$csequenceA :: forall lexeme (f :: * -> *) a.
Applicative f =>
NodeF lexeme (f a) -> f (NodeF lexeme a)
traverse :: (a -> f b) -> NodeF lexeme a -> f (NodeF lexeme b)
$ctraverse :: forall lexeme (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NodeF lexeme a -> f (NodeF lexeme b)
$cp2Traversable :: forall lexeme. Foldable (NodeF lexeme)
$cp1Traversable :: forall lexeme. Functor (NodeF lexeme)
Traversable)
    deriving ((Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> NodeF lexeme a -> ShowS
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [NodeF lexeme a] -> ShowS
(forall a.
 (Int -> a -> ShowS)
 -> ([a] -> ShowS) -> Int -> NodeF lexeme a -> ShowS)
-> (forall a.
    (Int -> a -> ShowS) -> ([a] -> ShowS) -> [NodeF lexeme a] -> ShowS)
-> Show1 (NodeF lexeme)
forall lexeme a.
Show lexeme =>
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> NodeF lexeme a -> ShowS
forall lexeme a.
Show lexeme =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [NodeF lexeme a] -> ShowS
forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> NodeF lexeme a -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [NodeF lexeme a] -> ShowS
forall (f :: * -> *).
(forall a.
 (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS)
-> (forall a.
    (Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS)
-> Show1 f
liftShowList :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> [NodeF lexeme a] -> ShowS
$cliftShowList :: forall lexeme a.
Show lexeme =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [NodeF lexeme a] -> ShowS
liftShowsPrec :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> NodeF lexeme a -> ShowS
$cliftShowsPrec :: forall lexeme a.
Show lexeme =>
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> NodeF lexeme a -> ShowS
Show1, ReadPrec a -> ReadPrec [a] -> ReadPrec (NodeF lexeme a)
ReadPrec a -> ReadPrec [a] -> ReadPrec [NodeF lexeme a]
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (NodeF lexeme a)
(Int -> ReadS a) -> ReadS [a] -> ReadS [NodeF lexeme a]
(forall a.
 (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (NodeF lexeme a))
-> (forall a.
    (Int -> ReadS a) -> ReadS [a] -> ReadS [NodeF lexeme a])
-> (forall a.
    ReadPrec a -> ReadPrec [a] -> ReadPrec (NodeF lexeme a))
-> (forall a.
    ReadPrec a -> ReadPrec [a] -> ReadPrec [NodeF lexeme a])
-> Read1 (NodeF lexeme)
forall lexeme a.
Read lexeme =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [NodeF lexeme a]
forall lexeme a.
Read lexeme =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (NodeF lexeme a)
forall lexeme a.
Read lexeme =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (NodeF lexeme a)
forall lexeme a.
Read lexeme =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [NodeF lexeme a]
forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [NodeF lexeme a]
forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (NodeF lexeme a)
forall a.
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (NodeF lexeme a)
forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [NodeF lexeme a]
forall (f :: * -> *).
(forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a))
-> (forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [f a])
-> (forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (f a))
-> (forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [f a])
-> Read1 f
liftReadListPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec [NodeF lexeme a]
$cliftReadListPrec :: forall lexeme a.
Read lexeme =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [NodeF lexeme a]
liftReadPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec (NodeF lexeme a)
$cliftReadPrec :: forall lexeme a.
Read lexeme =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (NodeF lexeme a)
liftReadList :: (Int -> ReadS a) -> ReadS [a] -> ReadS [NodeF lexeme a]
$cliftReadList :: forall lexeme a.
Read lexeme =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [NodeF lexeme a]
liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (NodeF lexeme a)
$cliftReadsPrec :: forall lexeme a.
Read lexeme =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (NodeF lexeme a)
Read1, (a -> b -> Bool) -> NodeF lexeme a -> NodeF lexeme b -> Bool
(forall a b.
 (a -> b -> Bool) -> NodeF lexeme a -> NodeF lexeme b -> Bool)
-> Eq1 (NodeF lexeme)
forall lexeme a b.
Eq lexeme =>
(a -> b -> Bool) -> NodeF lexeme a -> NodeF lexeme b -> Bool
forall a b.
(a -> b -> Bool) -> NodeF lexeme a -> NodeF lexeme b -> Bool
forall (f :: * -> *).
(forall a b. (a -> b -> Bool) -> f a -> f b -> Bool) -> Eq1 f
liftEq :: (a -> b -> Bool) -> NodeF lexeme a -> NodeF lexeme b -> Bool
$cliftEq :: forall lexeme a b.
Eq lexeme =>
(a -> b -> Bool) -> NodeF lexeme a -> NodeF lexeme b -> Bool
Eq1, Eq1 (NodeF lexeme)
Eq1 (NodeF lexeme)
-> (forall a b.
    (a -> b -> Ordering)
    -> NodeF lexeme a -> NodeF lexeme b -> Ordering)
-> Ord1 (NodeF lexeme)
(a -> b -> Ordering)
-> NodeF lexeme a -> NodeF lexeme b -> Ordering
forall lexeme. Ord lexeme => Eq1 (NodeF lexeme)
forall lexeme a b.
Ord lexeme =>
(a -> b -> Ordering)
-> NodeF lexeme a -> NodeF lexeme b -> Ordering
forall a b.
(a -> b -> Ordering)
-> NodeF lexeme a -> NodeF lexeme b -> Ordering
forall (f :: * -> *).
Eq1 f
-> (forall a b. (a -> b -> Ordering) -> f a -> f b -> Ordering)
-> Ord1 f
liftCompare :: (a -> b -> Ordering)
-> NodeF lexeme a -> NodeF lexeme b -> Ordering
$cliftCompare :: forall lexeme a b.
Ord lexeme =>
(a -> b -> Ordering)
-> NodeF lexeme a -> NodeF lexeme b -> Ordering
$cp1Ord1 :: forall lexeme. Ord lexeme => Eq1 (NodeF lexeme)
Ord1) via FunctorClassesDefault (NodeF lexeme)

type Node lexeme = Fix (NodeF lexeme)

instance FromJSON lexeme => FromJSON1 (NodeF lexeme)
instance ToJSON lexeme => ToJSON1 (NodeF lexeme)
instance Hashable lexeme => Hashable1 (NodeF lexeme)

data CommentF lexeme a
    = DocComment [a]

    | DocAttention
    | DocBrief
    | DocDeprecated
    | DocExtends lexeme
    | DocFile
    | DocImplements lexeme
    | DocNote
    | DocParam (Maybe lexeme) lexeme
    | DocReturn
    | DocRetval
    | DocSection lexeme
    | DocSecurityRank lexeme (Maybe lexeme) lexeme
    | DocSee lexeme
    | DocSubsection lexeme

    | DocPrivate

    | DocLine [a]
    | DocCode lexeme [a] lexeme

    | DocWord lexeme
    | DocRef lexeme
    | DocP lexeme
    deriving (Int -> CommentF lexeme a -> ShowS
[CommentF lexeme a] -> ShowS
CommentF lexeme a -> String
(Int -> CommentF lexeme a -> ShowS)
-> (CommentF lexeme a -> String)
-> ([CommentF lexeme a] -> ShowS)
-> Show (CommentF lexeme a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall lexeme a.
(Show a, Show lexeme) =>
Int -> CommentF lexeme a -> ShowS
forall lexeme a.
(Show a, Show lexeme) =>
[CommentF lexeme a] -> ShowS
forall lexeme a.
(Show a, Show lexeme) =>
CommentF lexeme a -> String
showList :: [CommentF lexeme a] -> ShowS
$cshowList :: forall lexeme a.
(Show a, Show lexeme) =>
[CommentF lexeme a] -> ShowS
show :: CommentF lexeme a -> String
$cshow :: forall lexeme a.
(Show a, Show lexeme) =>
CommentF lexeme a -> String
showsPrec :: Int -> CommentF lexeme a -> ShowS
$cshowsPrec :: forall lexeme a.
(Show a, Show lexeme) =>
Int -> CommentF lexeme a -> ShowS
Show, ReadPrec [CommentF lexeme a]
ReadPrec (CommentF lexeme a)
Int -> ReadS (CommentF lexeme a)
ReadS [CommentF lexeme a]
(Int -> ReadS (CommentF lexeme a))
-> ReadS [CommentF lexeme a]
-> ReadPrec (CommentF lexeme a)
-> ReadPrec [CommentF lexeme a]
-> Read (CommentF lexeme a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall lexeme a.
(Read a, Read lexeme) =>
ReadPrec [CommentF lexeme a]
forall lexeme a.
(Read a, Read lexeme) =>
ReadPrec (CommentF lexeme a)
forall lexeme a.
(Read a, Read lexeme) =>
Int -> ReadS (CommentF lexeme a)
forall lexeme a. (Read a, Read lexeme) => ReadS [CommentF lexeme a]
readListPrec :: ReadPrec [CommentF lexeme a]
$creadListPrec :: forall lexeme a.
(Read a, Read lexeme) =>
ReadPrec [CommentF lexeme a]
readPrec :: ReadPrec (CommentF lexeme a)
$creadPrec :: forall lexeme a.
(Read a, Read lexeme) =>
ReadPrec (CommentF lexeme a)
readList :: ReadS [CommentF lexeme a]
$creadList :: forall lexeme a. (Read a, Read lexeme) => ReadS [CommentF lexeme a]
readsPrec :: Int -> ReadS (CommentF lexeme a)
$creadsPrec :: forall lexeme a.
(Read a, Read lexeme) =>
Int -> ReadS (CommentF lexeme a)
Read, CommentF lexeme a -> CommentF lexeme a -> Bool
(CommentF lexeme a -> CommentF lexeme a -> Bool)
-> (CommentF lexeme a -> CommentF lexeme a -> Bool)
-> Eq (CommentF lexeme a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall lexeme a.
(Eq a, Eq lexeme) =>
CommentF lexeme a -> CommentF lexeme a -> Bool
/= :: CommentF lexeme a -> CommentF lexeme a -> Bool
$c/= :: forall lexeme a.
(Eq a, Eq lexeme) =>
CommentF lexeme a -> CommentF lexeme a -> Bool
== :: CommentF lexeme a -> CommentF lexeme a -> Bool
$c== :: forall lexeme a.
(Eq a, Eq lexeme) =>
CommentF lexeme a -> CommentF lexeme a -> Bool
Eq, Eq (CommentF lexeme a)
Eq (CommentF lexeme a)
-> (CommentF lexeme a -> CommentF lexeme a -> Ordering)
-> (CommentF lexeme a -> CommentF lexeme a -> Bool)
-> (CommentF lexeme a -> CommentF lexeme a -> Bool)
-> (CommentF lexeme a -> CommentF lexeme a -> Bool)
-> (CommentF lexeme a -> CommentF lexeme a -> Bool)
-> (CommentF lexeme a -> CommentF lexeme a -> CommentF lexeme a)
-> (CommentF lexeme a -> CommentF lexeme a -> CommentF lexeme a)
-> Ord (CommentF lexeme a)
CommentF lexeme a -> CommentF lexeme a -> Bool
CommentF lexeme a -> CommentF lexeme a -> Ordering
CommentF lexeme a -> CommentF lexeme a -> CommentF lexeme a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall lexeme a. (Ord a, Ord lexeme) => Eq (CommentF lexeme a)
forall lexeme a.
(Ord a, Ord lexeme) =>
CommentF lexeme a -> CommentF lexeme a -> Bool
forall lexeme a.
(Ord a, Ord lexeme) =>
CommentF lexeme a -> CommentF lexeme a -> Ordering
forall lexeme a.
(Ord a, Ord lexeme) =>
CommentF lexeme a -> CommentF lexeme a -> CommentF lexeme a
min :: CommentF lexeme a -> CommentF lexeme a -> CommentF lexeme a
$cmin :: forall lexeme a.
(Ord a, Ord lexeme) =>
CommentF lexeme a -> CommentF lexeme a -> CommentF lexeme a
max :: CommentF lexeme a -> CommentF lexeme a -> CommentF lexeme a
$cmax :: forall lexeme a.
(Ord a, Ord lexeme) =>
CommentF lexeme a -> CommentF lexeme a -> CommentF lexeme a
>= :: CommentF lexeme a -> CommentF lexeme a -> Bool
$c>= :: forall lexeme a.
(Ord a, Ord lexeme) =>
CommentF lexeme a -> CommentF lexeme a -> Bool
> :: CommentF lexeme a -> CommentF lexeme a -> Bool
$c> :: forall lexeme a.
(Ord a, Ord lexeme) =>
CommentF lexeme a -> CommentF lexeme a -> Bool
<= :: CommentF lexeme a -> CommentF lexeme a -> Bool
$c<= :: forall lexeme a.
(Ord a, Ord lexeme) =>
CommentF lexeme a -> CommentF lexeme a -> Bool
< :: CommentF lexeme a -> CommentF lexeme a -> Bool
$c< :: forall lexeme a.
(Ord a, Ord lexeme) =>
CommentF lexeme a -> CommentF lexeme a -> Bool
compare :: CommentF lexeme a -> CommentF lexeme a -> Ordering
$ccompare :: forall lexeme a.
(Ord a, Ord lexeme) =>
CommentF lexeme a -> CommentF lexeme a -> Ordering
$cp1Ord :: forall lexeme a. (Ord a, Ord lexeme) => Eq (CommentF lexeme a)
Ord, (forall x. CommentF lexeme a -> Rep (CommentF lexeme a) x)
-> (forall x. Rep (CommentF lexeme a) x -> CommentF lexeme a)
-> Generic (CommentF lexeme a)
forall x. Rep (CommentF lexeme a) x -> CommentF lexeme a
forall x. CommentF lexeme a -> Rep (CommentF lexeme a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall lexeme a x. Rep (CommentF lexeme a) x -> CommentF lexeme a
forall lexeme a x. CommentF lexeme a -> Rep (CommentF lexeme a) x
$cto :: forall lexeme a x. Rep (CommentF lexeme a) x -> CommentF lexeme a
$cfrom :: forall lexeme a x. CommentF lexeme a -> Rep (CommentF lexeme a) x
Generic, (forall a. CommentF lexeme a -> Rep1 (CommentF lexeme) a)
-> (forall a. Rep1 (CommentF lexeme) a -> CommentF lexeme a)
-> Generic1 (CommentF lexeme)
forall a. Rep1 (CommentF lexeme) a -> CommentF lexeme a
forall a. CommentF lexeme a -> Rep1 (CommentF lexeme) a
forall lexeme a. Rep1 (CommentF lexeme) a -> CommentF lexeme a
forall lexeme a. CommentF lexeme a -> Rep1 (CommentF lexeme) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall lexeme a. Rep1 (CommentF lexeme) a -> CommentF lexeme a
$cfrom1 :: forall lexeme a. CommentF lexeme a -> Rep1 (CommentF lexeme) a
Generic1, a -> CommentF lexeme b -> CommentF lexeme a
(a -> b) -> CommentF lexeme a -> CommentF lexeme b
(forall a b. (a -> b) -> CommentF lexeme a -> CommentF lexeme b)
-> (forall a b. a -> CommentF lexeme b -> CommentF lexeme a)
-> Functor (CommentF lexeme)
forall a b. a -> CommentF lexeme b -> CommentF lexeme a
forall a b. (a -> b) -> CommentF lexeme a -> CommentF lexeme b
forall lexeme a b. a -> CommentF lexeme b -> CommentF lexeme a
forall lexeme a b.
(a -> b) -> CommentF lexeme a -> CommentF lexeme b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> CommentF lexeme b -> CommentF lexeme a
$c<$ :: forall lexeme a b. a -> CommentF lexeme b -> CommentF lexeme a
fmap :: (a -> b) -> CommentF lexeme a -> CommentF lexeme b
$cfmap :: forall lexeme a b.
(a -> b) -> CommentF lexeme a -> CommentF lexeme b
Functor, CommentF lexeme a -> Bool
(a -> m) -> CommentF lexeme a -> m
(a -> b -> b) -> b -> CommentF lexeme a -> b
(forall m. Monoid m => CommentF lexeme m -> m)
-> (forall m a. Monoid m => (a -> m) -> CommentF lexeme a -> m)
-> (forall m a. Monoid m => (a -> m) -> CommentF lexeme a -> m)
-> (forall a b. (a -> b -> b) -> b -> CommentF lexeme a -> b)
-> (forall a b. (a -> b -> b) -> b -> CommentF lexeme a -> b)
-> (forall b a. (b -> a -> b) -> b -> CommentF lexeme a -> b)
-> (forall b a. (b -> a -> b) -> b -> CommentF lexeme a -> b)
-> (forall a. (a -> a -> a) -> CommentF lexeme a -> a)
-> (forall a. (a -> a -> a) -> CommentF lexeme a -> a)
-> (forall a. CommentF lexeme a -> [a])
-> (forall a. CommentF lexeme a -> Bool)
-> (forall a. CommentF lexeme a -> Int)
-> (forall a. Eq a => a -> CommentF lexeme a -> Bool)
-> (forall a. Ord a => CommentF lexeme a -> a)
-> (forall a. Ord a => CommentF lexeme a -> a)
-> (forall a. Num a => CommentF lexeme a -> a)
-> (forall a. Num a => CommentF lexeme a -> a)
-> Foldable (CommentF lexeme)
forall a. Eq a => a -> CommentF lexeme a -> Bool
forall a. Num a => CommentF lexeme a -> a
forall a. Ord a => CommentF lexeme a -> a
forall m. Monoid m => CommentF lexeme m -> m
forall a. CommentF lexeme a -> Bool
forall a. CommentF lexeme a -> Int
forall a. CommentF lexeme a -> [a]
forall a. (a -> a -> a) -> CommentF lexeme a -> a
forall lexeme a. Eq a => a -> CommentF lexeme a -> Bool
forall lexeme a. Num a => CommentF lexeme a -> a
forall lexeme a. Ord a => CommentF lexeme a -> a
forall m a. Monoid m => (a -> m) -> CommentF lexeme a -> m
forall lexeme m. Monoid m => CommentF lexeme m -> m
forall lexeme a. CommentF lexeme a -> Bool
forall lexeme a. CommentF lexeme a -> Int
forall lexeme a. CommentF lexeme a -> [a]
forall b a. (b -> a -> b) -> b -> CommentF lexeme a -> b
forall a b. (a -> b -> b) -> b -> CommentF lexeme a -> b
forall lexeme a. (a -> a -> a) -> CommentF lexeme a -> a
forall lexeme m a. Monoid m => (a -> m) -> CommentF lexeme a -> m
forall lexeme b a. (b -> a -> b) -> b -> CommentF lexeme a -> b
forall lexeme a b. (a -> b -> b) -> b -> CommentF lexeme 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 :: CommentF lexeme a -> a
$cproduct :: forall lexeme a. Num a => CommentF lexeme a -> a
sum :: CommentF lexeme a -> a
$csum :: forall lexeme a. Num a => CommentF lexeme a -> a
minimum :: CommentF lexeme a -> a
$cminimum :: forall lexeme a. Ord a => CommentF lexeme a -> a
maximum :: CommentF lexeme a -> a
$cmaximum :: forall lexeme a. Ord a => CommentF lexeme a -> a
elem :: a -> CommentF lexeme a -> Bool
$celem :: forall lexeme a. Eq a => a -> CommentF lexeme a -> Bool
length :: CommentF lexeme a -> Int
$clength :: forall lexeme a. CommentF lexeme a -> Int
null :: CommentF lexeme a -> Bool
$cnull :: forall lexeme a. CommentF lexeme a -> Bool
toList :: CommentF lexeme a -> [a]
$ctoList :: forall lexeme a. CommentF lexeme a -> [a]
foldl1 :: (a -> a -> a) -> CommentF lexeme a -> a
$cfoldl1 :: forall lexeme a. (a -> a -> a) -> CommentF lexeme a -> a
foldr1 :: (a -> a -> a) -> CommentF lexeme a -> a
$cfoldr1 :: forall lexeme a. (a -> a -> a) -> CommentF lexeme a -> a
foldl' :: (b -> a -> b) -> b -> CommentF lexeme a -> b
$cfoldl' :: forall lexeme b a. (b -> a -> b) -> b -> CommentF lexeme a -> b
foldl :: (b -> a -> b) -> b -> CommentF lexeme a -> b
$cfoldl :: forall lexeme b a. (b -> a -> b) -> b -> CommentF lexeme a -> b
foldr' :: (a -> b -> b) -> b -> CommentF lexeme a -> b
$cfoldr' :: forall lexeme a b. (a -> b -> b) -> b -> CommentF lexeme a -> b
foldr :: (a -> b -> b) -> b -> CommentF lexeme a -> b
$cfoldr :: forall lexeme a b. (a -> b -> b) -> b -> CommentF lexeme a -> b
foldMap' :: (a -> m) -> CommentF lexeme a -> m
$cfoldMap' :: forall lexeme m a. Monoid m => (a -> m) -> CommentF lexeme a -> m
foldMap :: (a -> m) -> CommentF lexeme a -> m
$cfoldMap :: forall lexeme m a. Monoid m => (a -> m) -> CommentF lexeme a -> m
fold :: CommentF lexeme m -> m
$cfold :: forall lexeme m. Monoid m => CommentF lexeme m -> m
Foldable, Functor (CommentF lexeme)
Foldable (CommentF lexeme)
Functor (CommentF lexeme)
-> Foldable (CommentF lexeme)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> CommentF lexeme a -> f (CommentF lexeme b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    CommentF lexeme (f a) -> f (CommentF lexeme a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> CommentF lexeme a -> m (CommentF lexeme b))
-> (forall (m :: * -> *) a.
    Monad m =>
    CommentF lexeme (m a) -> m (CommentF lexeme a))
-> Traversable (CommentF lexeme)
(a -> f b) -> CommentF lexeme a -> f (CommentF lexeme b)
forall lexeme. Functor (CommentF lexeme)
forall lexeme. Foldable (CommentF lexeme)
forall lexeme (m :: * -> *) a.
Monad m =>
CommentF lexeme (m a) -> m (CommentF lexeme a)
forall lexeme (f :: * -> *) a.
Applicative f =>
CommentF lexeme (f a) -> f (CommentF lexeme a)
forall lexeme (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CommentF lexeme a -> m (CommentF lexeme b)
forall lexeme (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CommentF lexeme a -> f (CommentF lexeme 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 =>
CommentF lexeme (m a) -> m (CommentF lexeme a)
forall (f :: * -> *) a.
Applicative f =>
CommentF lexeme (f a) -> f (CommentF lexeme a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CommentF lexeme a -> m (CommentF lexeme b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CommentF lexeme a -> f (CommentF lexeme b)
sequence :: CommentF lexeme (m a) -> m (CommentF lexeme a)
$csequence :: forall lexeme (m :: * -> *) a.
Monad m =>
CommentF lexeme (m a) -> m (CommentF lexeme a)
mapM :: (a -> m b) -> CommentF lexeme a -> m (CommentF lexeme b)
$cmapM :: forall lexeme (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CommentF lexeme a -> m (CommentF lexeme b)
sequenceA :: CommentF lexeme (f a) -> f (CommentF lexeme a)
$csequenceA :: forall lexeme (f :: * -> *) a.
Applicative f =>
CommentF lexeme (f a) -> f (CommentF lexeme a)
traverse :: (a -> f b) -> CommentF lexeme a -> f (CommentF lexeme b)
$ctraverse :: forall lexeme (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CommentF lexeme a -> f (CommentF lexeme b)
$cp2Traversable :: forall lexeme. Foldable (CommentF lexeme)
$cp1Traversable :: forall lexeme. Functor (CommentF lexeme)
Traversable)
    deriving ((Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> CommentF lexeme a -> ShowS
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> [CommentF lexeme a] -> ShowS
(forall a.
 (Int -> a -> ShowS)
 -> ([a] -> ShowS) -> Int -> CommentF lexeme a -> ShowS)
-> (forall a.
    (Int -> a -> ShowS)
    -> ([a] -> ShowS) -> [CommentF lexeme a] -> ShowS)
-> Show1 (CommentF lexeme)
forall lexeme a.
Show lexeme =>
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> CommentF lexeme a -> ShowS
forall lexeme a.
Show lexeme =>
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> [CommentF lexeme a] -> ShowS
forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> CommentF lexeme a -> ShowS
forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> [CommentF lexeme a] -> ShowS
forall (f :: * -> *).
(forall a.
 (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS)
-> (forall a.
    (Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS)
-> Show1 f
liftShowList :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> [CommentF lexeme a] -> ShowS
$cliftShowList :: forall lexeme a.
Show lexeme =>
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> [CommentF lexeme a] -> ShowS
liftShowsPrec :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> CommentF lexeme a -> ShowS
$cliftShowsPrec :: forall lexeme a.
Show lexeme =>
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> CommentF lexeme a -> ShowS
Show1, ReadPrec a -> ReadPrec [a] -> ReadPrec (CommentF lexeme a)
ReadPrec a -> ReadPrec [a] -> ReadPrec [CommentF lexeme a]
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (CommentF lexeme a)
(Int -> ReadS a) -> ReadS [a] -> ReadS [CommentF lexeme a]
(forall a.
 (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (CommentF lexeme a))
-> (forall a.
    (Int -> ReadS a) -> ReadS [a] -> ReadS [CommentF lexeme a])
-> (forall a.
    ReadPrec a -> ReadPrec [a] -> ReadPrec (CommentF lexeme a))
-> (forall a.
    ReadPrec a -> ReadPrec [a] -> ReadPrec [CommentF lexeme a])
-> Read1 (CommentF lexeme)
forall lexeme a.
Read lexeme =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [CommentF lexeme a]
forall lexeme a.
Read lexeme =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (CommentF lexeme a)
forall lexeme a.
Read lexeme =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (CommentF lexeme a)
forall lexeme a.
Read lexeme =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [CommentF lexeme a]
forall a.
ReadPrec a -> ReadPrec [a] -> ReadPrec [CommentF lexeme a]
forall a.
ReadPrec a -> ReadPrec [a] -> ReadPrec (CommentF lexeme a)
forall a.
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (CommentF lexeme a)
forall a.
(Int -> ReadS a) -> ReadS [a] -> ReadS [CommentF lexeme a]
forall (f :: * -> *).
(forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a))
-> (forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [f a])
-> (forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (f a))
-> (forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [f a])
-> Read1 f
liftReadListPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec [CommentF lexeme a]
$cliftReadListPrec :: forall lexeme a.
Read lexeme =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [CommentF lexeme a]
liftReadPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec (CommentF lexeme a)
$cliftReadPrec :: forall lexeme a.
Read lexeme =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (CommentF lexeme a)
liftReadList :: (Int -> ReadS a) -> ReadS [a] -> ReadS [CommentF lexeme a]
$cliftReadList :: forall lexeme a.
Read lexeme =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [CommentF lexeme a]
liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (CommentF lexeme a)
$cliftReadsPrec :: forall lexeme a.
Read lexeme =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (CommentF lexeme a)
Read1, (a -> b -> Bool) -> CommentF lexeme a -> CommentF lexeme b -> Bool
(forall a b.
 (a -> b -> Bool) -> CommentF lexeme a -> CommentF lexeme b -> Bool)
-> Eq1 (CommentF lexeme)
forall lexeme a b.
Eq lexeme =>
(a -> b -> Bool) -> CommentF lexeme a -> CommentF lexeme b -> Bool
forall a b.
(a -> b -> Bool) -> CommentF lexeme a -> CommentF lexeme b -> Bool
forall (f :: * -> *).
(forall a b. (a -> b -> Bool) -> f a -> f b -> Bool) -> Eq1 f
liftEq :: (a -> b -> Bool) -> CommentF lexeme a -> CommentF lexeme b -> Bool
$cliftEq :: forall lexeme a b.
Eq lexeme =>
(a -> b -> Bool) -> CommentF lexeme a -> CommentF lexeme b -> Bool
Eq1, Eq1 (CommentF lexeme)
Eq1 (CommentF lexeme)
-> (forall a b.
    (a -> b -> Ordering)
    -> CommentF lexeme a -> CommentF lexeme b -> Ordering)
-> Ord1 (CommentF lexeme)
(a -> b -> Ordering)
-> CommentF lexeme a -> CommentF lexeme b -> Ordering
forall lexeme. Ord lexeme => Eq1 (CommentF lexeme)
forall lexeme a b.
Ord lexeme =>
(a -> b -> Ordering)
-> CommentF lexeme a -> CommentF lexeme b -> Ordering
forall a b.
(a -> b -> Ordering)
-> CommentF lexeme a -> CommentF lexeme b -> Ordering
forall (f :: * -> *).
Eq1 f
-> (forall a b. (a -> b -> Ordering) -> f a -> f b -> Ordering)
-> Ord1 f
liftCompare :: (a -> b -> Ordering)
-> CommentF lexeme a -> CommentF lexeme b -> Ordering
$cliftCompare :: forall lexeme a b.
Ord lexeme =>
(a -> b -> Ordering)
-> CommentF lexeme a -> CommentF lexeme b -> Ordering
$cp1Ord1 :: forall lexeme. Ord lexeme => Eq1 (CommentF lexeme)
Ord1) via FunctorClassesDefault (CommentF lexeme)

type Comment lexeme = Fix (CommentF lexeme)

instance FromJSON lexeme => FromJSON1 (CommentF lexeme)
instance ToJSON lexeme => ToJSON1 (CommentF lexeme)
instance Hashable lexeme => Hashable1 (CommentF lexeme)

data AssignOp
    = AopEq
    | AopMul
    | AopDiv
    | AopPlus
    | AopMinus
    | AopBitAnd
    | AopBitOr
    | AopBitXor
    | AopMod
    | AopLsh
    | AopRsh
    deriving (Int -> AssignOp
AssignOp -> Int
AssignOp -> [AssignOp]
AssignOp -> AssignOp
AssignOp -> AssignOp -> [AssignOp]
AssignOp -> AssignOp -> AssignOp -> [AssignOp]
(AssignOp -> AssignOp)
-> (AssignOp -> AssignOp)
-> (Int -> AssignOp)
-> (AssignOp -> Int)
-> (AssignOp -> [AssignOp])
-> (AssignOp -> AssignOp -> [AssignOp])
-> (AssignOp -> AssignOp -> [AssignOp])
-> (AssignOp -> AssignOp -> AssignOp -> [AssignOp])
-> Enum AssignOp
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: AssignOp -> AssignOp -> AssignOp -> [AssignOp]
$cenumFromThenTo :: AssignOp -> AssignOp -> AssignOp -> [AssignOp]
enumFromTo :: AssignOp -> AssignOp -> [AssignOp]
$cenumFromTo :: AssignOp -> AssignOp -> [AssignOp]
enumFromThen :: AssignOp -> AssignOp -> [AssignOp]
$cenumFromThen :: AssignOp -> AssignOp -> [AssignOp]
enumFrom :: AssignOp -> [AssignOp]
$cenumFrom :: AssignOp -> [AssignOp]
fromEnum :: AssignOp -> Int
$cfromEnum :: AssignOp -> Int
toEnum :: Int -> AssignOp
$ctoEnum :: Int -> AssignOp
pred :: AssignOp -> AssignOp
$cpred :: AssignOp -> AssignOp
succ :: AssignOp -> AssignOp
$csucc :: AssignOp -> AssignOp
Enum, AssignOp
AssignOp -> AssignOp -> Bounded AssignOp
forall a. a -> a -> Bounded a
maxBound :: AssignOp
$cmaxBound :: AssignOp
minBound :: AssignOp
$cminBound :: AssignOp
Bounded, Eq AssignOp
Eq AssignOp
-> (AssignOp -> AssignOp -> Ordering)
-> (AssignOp -> AssignOp -> Bool)
-> (AssignOp -> AssignOp -> Bool)
-> (AssignOp -> AssignOp -> Bool)
-> (AssignOp -> AssignOp -> Bool)
-> (AssignOp -> AssignOp -> AssignOp)
-> (AssignOp -> AssignOp -> AssignOp)
-> Ord AssignOp
AssignOp -> AssignOp -> Bool
AssignOp -> AssignOp -> Ordering
AssignOp -> AssignOp -> AssignOp
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
min :: AssignOp -> AssignOp -> AssignOp
$cmin :: AssignOp -> AssignOp -> AssignOp
max :: AssignOp -> AssignOp -> AssignOp
$cmax :: AssignOp -> AssignOp -> AssignOp
>= :: AssignOp -> AssignOp -> Bool
$c>= :: AssignOp -> AssignOp -> Bool
> :: AssignOp -> AssignOp -> Bool
$c> :: AssignOp -> AssignOp -> Bool
<= :: AssignOp -> AssignOp -> Bool
$c<= :: AssignOp -> AssignOp -> Bool
< :: AssignOp -> AssignOp -> Bool
$c< :: AssignOp -> AssignOp -> Bool
compare :: AssignOp -> AssignOp -> Ordering
$ccompare :: AssignOp -> AssignOp -> Ordering
$cp1Ord :: Eq AssignOp
Ord, 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, ReadPrec [AssignOp]
ReadPrec AssignOp
Int -> ReadS AssignOp
ReadS [AssignOp]
(Int -> ReadS AssignOp)
-> ReadS [AssignOp]
-> ReadPrec AssignOp
-> ReadPrec [AssignOp]
-> Read AssignOp
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssignOp]
$creadListPrec :: ReadPrec [AssignOp]
readPrec :: ReadPrec AssignOp
$creadPrec :: ReadPrec AssignOp
readList :: ReadS [AssignOp]
$creadList :: ReadS [AssignOp]
readsPrec :: Int -> ReadS AssignOp
$creadsPrec :: Int -> ReadS AssignOp
Read, 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
BinaryOp -> Int
BinaryOp -> [BinaryOp]
BinaryOp -> BinaryOp
BinaryOp -> BinaryOp -> [BinaryOp]
BinaryOp -> BinaryOp -> BinaryOp -> [BinaryOp]
(BinaryOp -> BinaryOp)
-> (BinaryOp -> BinaryOp)
-> (Int -> BinaryOp)
-> (BinaryOp -> Int)
-> (BinaryOp -> [BinaryOp])
-> (BinaryOp -> BinaryOp -> [BinaryOp])
-> (BinaryOp -> BinaryOp -> [BinaryOp])
-> (BinaryOp -> BinaryOp -> BinaryOp -> [BinaryOp])
-> Enum BinaryOp
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BinaryOp -> BinaryOp -> BinaryOp -> [BinaryOp]
$cenumFromThenTo :: BinaryOp -> BinaryOp -> BinaryOp -> [BinaryOp]
enumFromTo :: BinaryOp -> BinaryOp -> [BinaryOp]
$cenumFromTo :: BinaryOp -> BinaryOp -> [BinaryOp]
enumFromThen :: BinaryOp -> BinaryOp -> [BinaryOp]
$cenumFromThen :: BinaryOp -> BinaryOp -> [BinaryOp]
enumFrom :: BinaryOp -> [BinaryOp]
$cenumFrom :: BinaryOp -> [BinaryOp]
fromEnum :: BinaryOp -> Int
$cfromEnum :: BinaryOp -> Int
toEnum :: Int -> BinaryOp
$ctoEnum :: Int -> BinaryOp
pred :: BinaryOp -> BinaryOp
$cpred :: BinaryOp -> BinaryOp
succ :: BinaryOp -> BinaryOp
$csucc :: BinaryOp -> BinaryOp
Enum, BinaryOp
BinaryOp -> BinaryOp -> Bounded BinaryOp
forall a. a -> a -> Bounded a
maxBound :: BinaryOp
$cmaxBound :: BinaryOp
minBound :: BinaryOp
$cminBound :: BinaryOp
Bounded, Eq BinaryOp
Eq BinaryOp
-> (BinaryOp -> BinaryOp -> Ordering)
-> (BinaryOp -> BinaryOp -> Bool)
-> (BinaryOp -> BinaryOp -> Bool)
-> (BinaryOp -> BinaryOp -> Bool)
-> (BinaryOp -> BinaryOp -> Bool)
-> (BinaryOp -> BinaryOp -> BinaryOp)
-> (BinaryOp -> BinaryOp -> BinaryOp)
-> Ord BinaryOp
BinaryOp -> BinaryOp -> Bool
BinaryOp -> BinaryOp -> Ordering
BinaryOp -> BinaryOp -> BinaryOp
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
min :: BinaryOp -> BinaryOp -> BinaryOp
$cmin :: BinaryOp -> BinaryOp -> BinaryOp
max :: BinaryOp -> BinaryOp -> BinaryOp
$cmax :: BinaryOp -> BinaryOp -> BinaryOp
>= :: BinaryOp -> BinaryOp -> Bool
$c>= :: BinaryOp -> BinaryOp -> Bool
> :: BinaryOp -> BinaryOp -> Bool
$c> :: BinaryOp -> BinaryOp -> Bool
<= :: BinaryOp -> BinaryOp -> Bool
$c<= :: BinaryOp -> BinaryOp -> Bool
< :: BinaryOp -> BinaryOp -> Bool
$c< :: BinaryOp -> BinaryOp -> Bool
compare :: BinaryOp -> BinaryOp -> Ordering
$ccompare :: BinaryOp -> BinaryOp -> Ordering
$cp1Ord :: Eq BinaryOp
Ord, 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, ReadPrec [BinaryOp]
ReadPrec BinaryOp
Int -> ReadS BinaryOp
ReadS [BinaryOp]
(Int -> ReadS BinaryOp)
-> ReadS [BinaryOp]
-> ReadPrec BinaryOp
-> ReadPrec [BinaryOp]
-> Read BinaryOp
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BinaryOp]
$creadListPrec :: ReadPrec [BinaryOp]
readPrec :: ReadPrec BinaryOp
$creadPrec :: ReadPrec BinaryOp
readList :: ReadS [BinaryOp]
$creadList :: ReadS [BinaryOp]
readsPrec :: Int -> ReadS BinaryOp
$creadsPrec :: Int -> ReadS BinaryOp
Read, 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
UnaryOp -> Int
UnaryOp -> [UnaryOp]
UnaryOp -> UnaryOp
UnaryOp -> UnaryOp -> [UnaryOp]
UnaryOp -> UnaryOp -> UnaryOp -> [UnaryOp]
(UnaryOp -> UnaryOp)
-> (UnaryOp -> UnaryOp)
-> (Int -> UnaryOp)
-> (UnaryOp -> Int)
-> (UnaryOp -> [UnaryOp])
-> (UnaryOp -> UnaryOp -> [UnaryOp])
-> (UnaryOp -> UnaryOp -> [UnaryOp])
-> (UnaryOp -> UnaryOp -> UnaryOp -> [UnaryOp])
-> Enum UnaryOp
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: UnaryOp -> UnaryOp -> UnaryOp -> [UnaryOp]
$cenumFromThenTo :: UnaryOp -> UnaryOp -> UnaryOp -> [UnaryOp]
enumFromTo :: UnaryOp -> UnaryOp -> [UnaryOp]
$cenumFromTo :: UnaryOp -> UnaryOp -> [UnaryOp]
enumFromThen :: UnaryOp -> UnaryOp -> [UnaryOp]
$cenumFromThen :: UnaryOp -> UnaryOp -> [UnaryOp]
enumFrom :: UnaryOp -> [UnaryOp]
$cenumFrom :: UnaryOp -> [UnaryOp]
fromEnum :: UnaryOp -> Int
$cfromEnum :: UnaryOp -> Int
toEnum :: Int -> UnaryOp
$ctoEnum :: Int -> UnaryOp
pred :: UnaryOp -> UnaryOp
$cpred :: UnaryOp -> UnaryOp
succ :: UnaryOp -> UnaryOp
$csucc :: UnaryOp -> UnaryOp
Enum, UnaryOp
UnaryOp -> UnaryOp -> Bounded UnaryOp
forall a. a -> a -> Bounded a
maxBound :: UnaryOp
$cmaxBound :: UnaryOp
minBound :: UnaryOp
$cminBound :: UnaryOp
Bounded, Eq UnaryOp
Eq UnaryOp
-> (UnaryOp -> UnaryOp -> Ordering)
-> (UnaryOp -> UnaryOp -> Bool)
-> (UnaryOp -> UnaryOp -> Bool)
-> (UnaryOp -> UnaryOp -> Bool)
-> (UnaryOp -> UnaryOp -> Bool)
-> (UnaryOp -> UnaryOp -> UnaryOp)
-> (UnaryOp -> UnaryOp -> UnaryOp)
-> Ord UnaryOp
UnaryOp -> UnaryOp -> Bool
UnaryOp -> UnaryOp -> Ordering
UnaryOp -> UnaryOp -> UnaryOp
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
min :: UnaryOp -> UnaryOp -> UnaryOp
$cmin :: UnaryOp -> UnaryOp -> UnaryOp
max :: UnaryOp -> UnaryOp -> UnaryOp
$cmax :: UnaryOp -> UnaryOp -> UnaryOp
>= :: UnaryOp -> UnaryOp -> Bool
$c>= :: UnaryOp -> UnaryOp -> Bool
> :: UnaryOp -> UnaryOp -> Bool
$c> :: UnaryOp -> UnaryOp -> Bool
<= :: UnaryOp -> UnaryOp -> Bool
$c<= :: UnaryOp -> UnaryOp -> Bool
< :: UnaryOp -> UnaryOp -> Bool
$c< :: UnaryOp -> UnaryOp -> Bool
compare :: UnaryOp -> UnaryOp -> Ordering
$ccompare :: UnaryOp -> UnaryOp -> Ordering
$cp1Ord :: Eq UnaryOp
Ord, 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, ReadPrec [UnaryOp]
ReadPrec UnaryOp
Int -> ReadS UnaryOp
ReadS [UnaryOp]
(Int -> ReadS UnaryOp)
-> ReadS [UnaryOp]
-> ReadPrec UnaryOp
-> ReadPrec [UnaryOp]
-> Read UnaryOp
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UnaryOp]
$creadListPrec :: ReadPrec [UnaryOp]
readPrec :: ReadPrec UnaryOp
$creadPrec :: ReadPrec UnaryOp
readList :: ReadS [UnaryOp]
$creadList :: ReadS [UnaryOp]
readsPrec :: Int -> ReadS UnaryOp
$creadsPrec :: Int -> ReadS UnaryOp
Read, 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
LiteralType -> Int
LiteralType -> [LiteralType]
LiteralType -> LiteralType
LiteralType -> LiteralType -> [LiteralType]
LiteralType -> LiteralType -> LiteralType -> [LiteralType]
(LiteralType -> LiteralType)
-> (LiteralType -> LiteralType)
-> (Int -> LiteralType)
-> (LiteralType -> Int)
-> (LiteralType -> [LiteralType])
-> (LiteralType -> LiteralType -> [LiteralType])
-> (LiteralType -> LiteralType -> [LiteralType])
-> (LiteralType -> LiteralType -> LiteralType -> [LiteralType])
-> Enum LiteralType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: LiteralType -> LiteralType -> LiteralType -> [LiteralType]
$cenumFromThenTo :: LiteralType -> LiteralType -> LiteralType -> [LiteralType]
enumFromTo :: LiteralType -> LiteralType -> [LiteralType]
$cenumFromTo :: LiteralType -> LiteralType -> [LiteralType]
enumFromThen :: LiteralType -> LiteralType -> [LiteralType]
$cenumFromThen :: LiteralType -> LiteralType -> [LiteralType]
enumFrom :: LiteralType -> [LiteralType]
$cenumFrom :: LiteralType -> [LiteralType]
fromEnum :: LiteralType -> Int
$cfromEnum :: LiteralType -> Int
toEnum :: Int -> LiteralType
$ctoEnum :: Int -> LiteralType
pred :: LiteralType -> LiteralType
$cpred :: LiteralType -> LiteralType
succ :: LiteralType -> LiteralType
$csucc :: LiteralType -> LiteralType
Enum, LiteralType
LiteralType -> LiteralType -> Bounded LiteralType
forall a. a -> a -> Bounded a
maxBound :: LiteralType
$cmaxBound :: LiteralType
minBound :: LiteralType
$cminBound :: LiteralType
Bounded, Eq LiteralType
Eq LiteralType
-> (LiteralType -> LiteralType -> Ordering)
-> (LiteralType -> LiteralType -> Bool)
-> (LiteralType -> LiteralType -> Bool)
-> (LiteralType -> LiteralType -> Bool)
-> (LiteralType -> LiteralType -> Bool)
-> (LiteralType -> LiteralType -> LiteralType)
-> (LiteralType -> LiteralType -> LiteralType)
-> Ord LiteralType
LiteralType -> LiteralType -> Bool
LiteralType -> LiteralType -> Ordering
LiteralType -> LiteralType -> LiteralType
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
min :: LiteralType -> LiteralType -> LiteralType
$cmin :: LiteralType -> LiteralType -> LiteralType
max :: LiteralType -> LiteralType -> LiteralType
$cmax :: LiteralType -> LiteralType -> LiteralType
>= :: LiteralType -> LiteralType -> Bool
$c>= :: LiteralType -> LiteralType -> Bool
> :: LiteralType -> LiteralType -> Bool
$c> :: LiteralType -> LiteralType -> Bool
<= :: LiteralType -> LiteralType -> Bool
$c<= :: LiteralType -> LiteralType -> Bool
< :: LiteralType -> LiteralType -> Bool
$c< :: LiteralType -> LiteralType -> Bool
compare :: LiteralType -> LiteralType -> Ordering
$ccompare :: LiteralType -> LiteralType -> Ordering
$cp1Ord :: Eq LiteralType
Ord, 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, ReadPrec [LiteralType]
ReadPrec LiteralType
Int -> ReadS LiteralType
ReadS [LiteralType]
(Int -> ReadS LiteralType)
-> ReadS [LiteralType]
-> ReadPrec LiteralType
-> ReadPrec [LiteralType]
-> Read LiteralType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LiteralType]
$creadListPrec :: ReadPrec [LiteralType]
readPrec :: ReadPrec LiteralType
$creadPrec :: ReadPrec LiteralType
readList :: ReadS [LiteralType]
$creadList :: ReadS [LiteralType]
readsPrec :: Int -> ReadS LiteralType
$creadsPrec :: Int -> ReadS LiteralType
Read, 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
    | Local
    deriving (Int -> Scope
Scope -> Int
Scope -> [Scope]
Scope -> Scope
Scope -> Scope -> [Scope]
Scope -> Scope -> Scope -> [Scope]
(Scope -> Scope)
-> (Scope -> Scope)
-> (Int -> Scope)
-> (Scope -> Int)
-> (Scope -> [Scope])
-> (Scope -> Scope -> [Scope])
-> (Scope -> Scope -> [Scope])
-> (Scope -> Scope -> Scope -> [Scope])
-> Enum Scope
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Scope -> Scope -> Scope -> [Scope]
$cenumFromThenTo :: Scope -> Scope -> Scope -> [Scope]
enumFromTo :: Scope -> Scope -> [Scope]
$cenumFromTo :: Scope -> Scope -> [Scope]
enumFromThen :: Scope -> Scope -> [Scope]
$cenumFromThen :: Scope -> Scope -> [Scope]
enumFrom :: Scope -> [Scope]
$cenumFrom :: Scope -> [Scope]
fromEnum :: Scope -> Int
$cfromEnum :: Scope -> Int
toEnum :: Int -> Scope
$ctoEnum :: Int -> Scope
pred :: Scope -> Scope
$cpred :: Scope -> Scope
succ :: Scope -> Scope
$csucc :: Scope -> Scope
Enum, Scope
Scope -> Scope -> Bounded Scope
forall a. a -> a -> Bounded a
maxBound :: Scope
$cmaxBound :: Scope
minBound :: Scope
$cminBound :: Scope
Bounded, Eq Scope
Eq Scope
-> (Scope -> Scope -> Ordering)
-> (Scope -> Scope -> Bool)
-> (Scope -> Scope -> Bool)
-> (Scope -> Scope -> Bool)
-> (Scope -> Scope -> Bool)
-> (Scope -> Scope -> Scope)
-> (Scope -> Scope -> Scope)
-> Ord Scope
Scope -> Scope -> Bool
Scope -> Scope -> Ordering
Scope -> Scope -> Scope
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
min :: Scope -> Scope -> Scope
$cmin :: Scope -> Scope -> Scope
max :: Scope -> Scope -> Scope
$cmax :: Scope -> Scope -> Scope
>= :: Scope -> Scope -> Bool
$c>= :: Scope -> Scope -> Bool
> :: Scope -> Scope -> Bool
$c> :: Scope -> Scope -> Bool
<= :: Scope -> Scope -> Bool
$c<= :: Scope -> Scope -> Bool
< :: Scope -> Scope -> Bool
$c< :: Scope -> Scope -> Bool
compare :: Scope -> Scope -> Ordering
$ccompare :: Scope -> Scope -> Ordering
$cp1Ord :: Eq Scope
Ord, 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, ReadPrec [Scope]
ReadPrec Scope
Int -> ReadS Scope
ReadS [Scope]
(Int -> ReadS Scope)
-> ReadS [Scope]
-> ReadPrec Scope
-> ReadPrec [Scope]
-> Read Scope
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Scope]
$creadListPrec :: ReadPrec [Scope]
readPrec :: ReadPrec Scope
$creadPrec :: ReadPrec Scope
readList :: ReadS [Scope]
$creadList :: ReadS [Scope]
readsPrec :: Int -> ReadS Scope
$creadsPrec :: Int -> ReadS Scope
Read, 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
    | Section
    | Block
    | Ignore
    deriving (Int -> CommentStyle
CommentStyle -> Int
CommentStyle -> [CommentStyle]
CommentStyle -> CommentStyle
CommentStyle -> CommentStyle -> [CommentStyle]
CommentStyle -> CommentStyle -> CommentStyle -> [CommentStyle]
(CommentStyle -> CommentStyle)
-> (CommentStyle -> CommentStyle)
-> (Int -> CommentStyle)
-> (CommentStyle -> Int)
-> (CommentStyle -> [CommentStyle])
-> (CommentStyle -> CommentStyle -> [CommentStyle])
-> (CommentStyle -> CommentStyle -> [CommentStyle])
-> (CommentStyle -> CommentStyle -> CommentStyle -> [CommentStyle])
-> Enum CommentStyle
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CommentStyle -> CommentStyle -> CommentStyle -> [CommentStyle]
$cenumFromThenTo :: CommentStyle -> CommentStyle -> CommentStyle -> [CommentStyle]
enumFromTo :: CommentStyle -> CommentStyle -> [CommentStyle]
$cenumFromTo :: CommentStyle -> CommentStyle -> [CommentStyle]
enumFromThen :: CommentStyle -> CommentStyle -> [CommentStyle]
$cenumFromThen :: CommentStyle -> CommentStyle -> [CommentStyle]
enumFrom :: CommentStyle -> [CommentStyle]
$cenumFrom :: CommentStyle -> [CommentStyle]
fromEnum :: CommentStyle -> Int
$cfromEnum :: CommentStyle -> Int
toEnum :: Int -> CommentStyle
$ctoEnum :: Int -> CommentStyle
pred :: CommentStyle -> CommentStyle
$cpred :: CommentStyle -> CommentStyle
succ :: CommentStyle -> CommentStyle
$csucc :: CommentStyle -> CommentStyle
Enum, CommentStyle
CommentStyle -> CommentStyle -> Bounded CommentStyle
forall a. a -> a -> Bounded a
maxBound :: CommentStyle
$cmaxBound :: CommentStyle
minBound :: CommentStyle
$cminBound :: CommentStyle
Bounded, Eq CommentStyle
Eq CommentStyle
-> (CommentStyle -> CommentStyle -> Ordering)
-> (CommentStyle -> CommentStyle -> Bool)
-> (CommentStyle -> CommentStyle -> Bool)
-> (CommentStyle -> CommentStyle -> Bool)
-> (CommentStyle -> CommentStyle -> Bool)
-> (CommentStyle -> CommentStyle -> CommentStyle)
-> (CommentStyle -> CommentStyle -> CommentStyle)
-> Ord CommentStyle
CommentStyle -> CommentStyle -> Bool
CommentStyle -> CommentStyle -> Ordering
CommentStyle -> CommentStyle -> CommentStyle
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
min :: CommentStyle -> CommentStyle -> CommentStyle
$cmin :: CommentStyle -> CommentStyle -> CommentStyle
max :: CommentStyle -> CommentStyle -> CommentStyle
$cmax :: CommentStyle -> CommentStyle -> CommentStyle
>= :: CommentStyle -> CommentStyle -> Bool
$c>= :: CommentStyle -> CommentStyle -> Bool
> :: CommentStyle -> CommentStyle -> Bool
$c> :: CommentStyle -> CommentStyle -> Bool
<= :: CommentStyle -> CommentStyle -> Bool
$c<= :: CommentStyle -> CommentStyle -> Bool
< :: CommentStyle -> CommentStyle -> Bool
$c< :: CommentStyle -> CommentStyle -> Bool
compare :: CommentStyle -> CommentStyle -> Ordering
$ccompare :: CommentStyle -> CommentStyle -> Ordering
$cp1Ord :: Eq CommentStyle
Ord, 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, ReadPrec [CommentStyle]
ReadPrec CommentStyle
Int -> ReadS CommentStyle
ReadS [CommentStyle]
(Int -> ReadS CommentStyle)
-> ReadS [CommentStyle]
-> ReadPrec CommentStyle
-> ReadPrec [CommentStyle]
-> Read CommentStyle
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CommentStyle]
$creadListPrec :: ReadPrec [CommentStyle]
readPrec :: ReadPrec CommentStyle
$creadPrec :: ReadPrec CommentStyle
readList :: ReadS [CommentStyle]
$creadList :: ReadS [CommentStyle]
readsPrec :: Int -> ReadS CommentStyle
$creadsPrec :: Int -> ReadS CommentStyle
Read, 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

data Nullability
    = NullabilityUnspecified
    | Nullable
    | Nonnull
    deriving (Int -> Nullability
Nullability -> Int
Nullability -> [Nullability]
Nullability -> Nullability
Nullability -> Nullability -> [Nullability]
Nullability -> Nullability -> Nullability -> [Nullability]
(Nullability -> Nullability)
-> (Nullability -> Nullability)
-> (Int -> Nullability)
-> (Nullability -> Int)
-> (Nullability -> [Nullability])
-> (Nullability -> Nullability -> [Nullability])
-> (Nullability -> Nullability -> [Nullability])
-> (Nullability -> Nullability -> Nullability -> [Nullability])
-> Enum Nullability
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Nullability -> Nullability -> Nullability -> [Nullability]
$cenumFromThenTo :: Nullability -> Nullability -> Nullability -> [Nullability]
enumFromTo :: Nullability -> Nullability -> [Nullability]
$cenumFromTo :: Nullability -> Nullability -> [Nullability]
enumFromThen :: Nullability -> Nullability -> [Nullability]
$cenumFromThen :: Nullability -> Nullability -> [Nullability]
enumFrom :: Nullability -> [Nullability]
$cenumFrom :: Nullability -> [Nullability]
fromEnum :: Nullability -> Int
$cfromEnum :: Nullability -> Int
toEnum :: Int -> Nullability
$ctoEnum :: Int -> Nullability
pred :: Nullability -> Nullability
$cpred :: Nullability -> Nullability
succ :: Nullability -> Nullability
$csucc :: Nullability -> Nullability
Enum, Nullability
Nullability -> Nullability -> Bounded Nullability
forall a. a -> a -> Bounded a
maxBound :: Nullability
$cmaxBound :: Nullability
minBound :: Nullability
$cminBound :: Nullability
Bounded, Eq Nullability
Eq Nullability
-> (Nullability -> Nullability -> Ordering)
-> (Nullability -> Nullability -> Bool)
-> (Nullability -> Nullability -> Bool)
-> (Nullability -> Nullability -> Bool)
-> (Nullability -> Nullability -> Bool)
-> (Nullability -> Nullability -> Nullability)
-> (Nullability -> Nullability -> Nullability)
-> Ord Nullability
Nullability -> Nullability -> Bool
Nullability -> Nullability -> Ordering
Nullability -> Nullability -> Nullability
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
min :: Nullability -> Nullability -> Nullability
$cmin :: Nullability -> Nullability -> Nullability
max :: Nullability -> Nullability -> Nullability
$cmax :: Nullability -> Nullability -> Nullability
>= :: Nullability -> Nullability -> Bool
$c>= :: Nullability -> Nullability -> Bool
> :: Nullability -> Nullability -> Bool
$c> :: Nullability -> Nullability -> Bool
<= :: Nullability -> Nullability -> Bool
$c<= :: Nullability -> Nullability -> Bool
< :: Nullability -> Nullability -> Bool
$c< :: Nullability -> Nullability -> Bool
compare :: Nullability -> Nullability -> Ordering
$ccompare :: Nullability -> Nullability -> Ordering
$cp1Ord :: Eq Nullability
Ord, Int -> Nullability -> ShowS
[Nullability] -> ShowS
Nullability -> String
(Int -> Nullability -> ShowS)
-> (Nullability -> String)
-> ([Nullability] -> ShowS)
-> Show Nullability
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Nullability] -> ShowS
$cshowList :: [Nullability] -> ShowS
show :: Nullability -> String
$cshow :: Nullability -> String
showsPrec :: Int -> Nullability -> ShowS
$cshowsPrec :: Int -> Nullability -> ShowS
Show, ReadPrec [Nullability]
ReadPrec Nullability
Int -> ReadS Nullability
ReadS [Nullability]
(Int -> ReadS Nullability)
-> ReadS [Nullability]
-> ReadPrec Nullability
-> ReadPrec [Nullability]
-> Read Nullability
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Nullability]
$creadListPrec :: ReadPrec [Nullability]
readPrec :: ReadPrec Nullability
$creadPrec :: ReadPrec Nullability
readList :: ReadS [Nullability]
$creadList :: ReadS [Nullability]
readsPrec :: Int -> ReadS Nullability
$creadsPrec :: Int -> ReadS Nullability
Read, Nullability -> Nullability -> Bool
(Nullability -> Nullability -> Bool)
-> (Nullability -> Nullability -> Bool) -> Eq Nullability
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Nullability -> Nullability -> Bool
$c/= :: Nullability -> Nullability -> Bool
== :: Nullability -> Nullability -> Bool
$c== :: Nullability -> Nullability -> Bool
Eq, (forall x. Nullability -> Rep Nullability x)
-> (forall x. Rep Nullability x -> Nullability)
-> Generic Nullability
forall x. Rep Nullability x -> Nullability
forall x. Nullability -> Rep Nullability x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Nullability x -> Nullability
$cfrom :: forall x. Nullability -> Rep Nullability x
Generic)

instance FromJSON Nullability
instance ToJSON Nullability

instance (Hashable lexeme, Hashable a) => Hashable (NodeF lexeme a) where
instance (Hashable lexeme, Hashable a) => Hashable (CommentF lexeme a) where
instance Hashable AssignOp where
instance Hashable BinaryOp where
instance Hashable UnaryOp where
instance Hashable LiteralType where
instance Hashable Scope where
instance Hashable CommentStyle where
instance Hashable Nullability where