{-# LANGUAGE DeriveDataTypeable     #-}
{-# LANGUAGE DeriveFunctor          #-}
{-# LANGUAGE DeriveGeneric          #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE RankNTypes             #-}
module Language.Thrift.Internal.AST
    (
    -- * AST

      Program(..)
    , headers
    , definitions

    , Header(..)

    , Include(..)
    , path

    , Namespace(..)
    , language

    , Definition(..)

    , Const(..)
    , Service(..)
    , functions
    , extends

    , Type(..)

    , Typedef(..)
    , targetType

    , Enum(..)

    , StructKind(..)
    , Struct(..)
    , kind

    , Union
    , unionName
    , unionFields
    , unionAnnotations
    , unionDocstring
    , unionSrcAnnot

    , Exception
    , exceptionName
    , exceptionFields
    , exceptionAnnotations
    , exceptionDocstring
    , exceptionSrcAnnot

    , Senum(..)

    , FieldRequiredness(..)

    , Field(..)
    , identifier
    , requiredness
    , defaultValue

    , EnumDef(..)

    , ConstValue(..)

    , TypeReference(..)

    , Function(..)
    , oneWay
    , returnType
    , parameters
    , exceptions

    , TypeAnnotation(..)
    , Docstring

    -- * Typeclasses

    , HasAnnotations(..)
    , HasDocstring(..)
    , HasFields(..)
    , HasName(..)
    , HasSrcAnnot(..)
    , HasValue(..)
    , HasValues(..)
    , HasValueType(..)
    ) where

import Data.Data    (Data, Typeable)
import Data.Text    (Text)
import GHC.Generics (Generic)
import Prelude      hiding (Enum)

import Language.Thrift.Internal.Lens

class HasSrcAnnot t where
    srcAnnot :: Lens (t a) a

class HasName t where
    name :: Lens t Text

class HasValue s a | s -> a where
    value :: Lens s a

-- | Type annoations may be added in various places in the form,
--
-- > (foo = "bar", baz, qux = "quux")
--
-- These do not usually affect code generation but allow for custom logic if
-- writing your own code generator.
data TypeAnnotation = TypeAnnotation
    { TypeAnnotation -> Text
typeAnnotationName  :: Text
    -- ^ Name of the annotation.
    , TypeAnnotation -> Maybe Text
typeAnnotationValue :: Maybe Text
    -- ^ Value for the annotation.
    }
  deriving (Int -> TypeAnnotation -> ShowS
[TypeAnnotation] -> ShowS
TypeAnnotation -> String
(Int -> TypeAnnotation -> ShowS)
-> (TypeAnnotation -> String)
-> ([TypeAnnotation] -> ShowS)
-> Show TypeAnnotation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeAnnotation -> ShowS
showsPrec :: Int -> TypeAnnotation -> ShowS
$cshow :: TypeAnnotation -> String
show :: TypeAnnotation -> String
$cshowList :: [TypeAnnotation] -> ShowS
showList :: [TypeAnnotation] -> ShowS
Show, Eq TypeAnnotation
Eq TypeAnnotation =>
(TypeAnnotation -> TypeAnnotation -> Ordering)
-> (TypeAnnotation -> TypeAnnotation -> Bool)
-> (TypeAnnotation -> TypeAnnotation -> Bool)
-> (TypeAnnotation -> TypeAnnotation -> Bool)
-> (TypeAnnotation -> TypeAnnotation -> Bool)
-> (TypeAnnotation -> TypeAnnotation -> TypeAnnotation)
-> (TypeAnnotation -> TypeAnnotation -> TypeAnnotation)
-> Ord TypeAnnotation
TypeAnnotation -> TypeAnnotation -> Bool
TypeAnnotation -> TypeAnnotation -> Ordering
TypeAnnotation -> TypeAnnotation -> TypeAnnotation
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TypeAnnotation -> TypeAnnotation -> Ordering
compare :: TypeAnnotation -> TypeAnnotation -> Ordering
$c< :: TypeAnnotation -> TypeAnnotation -> Bool
< :: TypeAnnotation -> TypeAnnotation -> Bool
$c<= :: TypeAnnotation -> TypeAnnotation -> Bool
<= :: TypeAnnotation -> TypeAnnotation -> Bool
$c> :: TypeAnnotation -> TypeAnnotation -> Bool
> :: TypeAnnotation -> TypeAnnotation -> Bool
$c>= :: TypeAnnotation -> TypeAnnotation -> Bool
>= :: TypeAnnotation -> TypeAnnotation -> Bool
$cmax :: TypeAnnotation -> TypeAnnotation -> TypeAnnotation
max :: TypeAnnotation -> TypeAnnotation -> TypeAnnotation
$cmin :: TypeAnnotation -> TypeAnnotation -> TypeAnnotation
min :: TypeAnnotation -> TypeAnnotation -> TypeAnnotation
Ord, TypeAnnotation -> TypeAnnotation -> Bool
(TypeAnnotation -> TypeAnnotation -> Bool)
-> (TypeAnnotation -> TypeAnnotation -> Bool) -> Eq TypeAnnotation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeAnnotation -> TypeAnnotation -> Bool
== :: TypeAnnotation -> TypeAnnotation -> Bool
$c/= :: TypeAnnotation -> TypeAnnotation -> Bool
/= :: TypeAnnotation -> TypeAnnotation -> Bool
Eq, Typeable TypeAnnotation
Typeable TypeAnnotation =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> TypeAnnotation -> c TypeAnnotation)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TypeAnnotation)
-> (TypeAnnotation -> Constr)
-> (TypeAnnotation -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TypeAnnotation))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c TypeAnnotation))
-> ((forall b. Data b => b -> b)
    -> TypeAnnotation -> TypeAnnotation)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TypeAnnotation -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TypeAnnotation -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> TypeAnnotation -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> TypeAnnotation -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> TypeAnnotation -> m TypeAnnotation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> TypeAnnotation -> m TypeAnnotation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> TypeAnnotation -> m TypeAnnotation)
-> Data TypeAnnotation
TypeAnnotation -> Constr
TypeAnnotation -> DataType
(forall b. Data b => b -> b) -> TypeAnnotation -> TypeAnnotation
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> TypeAnnotation -> u
forall u. (forall d. Data d => d -> u) -> TypeAnnotation -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeAnnotation -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeAnnotation -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TypeAnnotation -> m TypeAnnotation
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TypeAnnotation -> m TypeAnnotation
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeAnnotation
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeAnnotation -> c TypeAnnotation
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeAnnotation)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TypeAnnotation)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeAnnotation -> c TypeAnnotation
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TypeAnnotation -> c TypeAnnotation
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeAnnotation
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TypeAnnotation
$ctoConstr :: TypeAnnotation -> Constr
toConstr :: TypeAnnotation -> Constr
$cdataTypeOf :: TypeAnnotation -> DataType
dataTypeOf :: TypeAnnotation -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeAnnotation)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TypeAnnotation)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TypeAnnotation)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TypeAnnotation)
$cgmapT :: (forall b. Data b => b -> b) -> TypeAnnotation -> TypeAnnotation
gmapT :: (forall b. Data b => b -> b) -> TypeAnnotation -> TypeAnnotation
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeAnnotation -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TypeAnnotation -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeAnnotation -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TypeAnnotation -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TypeAnnotation -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> TypeAnnotation -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> TypeAnnotation -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> TypeAnnotation -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TypeAnnotation -> m TypeAnnotation
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TypeAnnotation -> m TypeAnnotation
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TypeAnnotation -> m TypeAnnotation
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TypeAnnotation -> m TypeAnnotation
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TypeAnnotation -> m TypeAnnotation
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TypeAnnotation -> m TypeAnnotation
Data, Typeable, (forall x. TypeAnnotation -> Rep TypeAnnotation x)
-> (forall x. Rep TypeAnnotation x -> TypeAnnotation)
-> Generic TypeAnnotation
forall x. Rep TypeAnnotation x -> TypeAnnotation
forall x. TypeAnnotation -> Rep TypeAnnotation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TypeAnnotation -> Rep TypeAnnotation x
from :: forall x. TypeAnnotation -> Rep TypeAnnotation x
$cto :: forall x. Rep TypeAnnotation x -> TypeAnnotation
to :: forall x. Rep TypeAnnotation x -> TypeAnnotation
Generic)

instance HasName TypeAnnotation where
    name :: Lens TypeAnnotation Text
name = (TypeAnnotation -> Text)
-> (TypeAnnotation -> Text -> TypeAnnotation)
-> Lens TypeAnnotation Text
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens TypeAnnotation -> Text
typeAnnotationName (\TypeAnnotation
s Text
a -> TypeAnnotation
s { typeAnnotationName = a })

instance HasValue TypeAnnotation (Maybe Text) where
    value :: Lens TypeAnnotation (Maybe Text)
value = (TypeAnnotation -> Maybe Text)
-> (TypeAnnotation -> Maybe Text -> TypeAnnotation)
-> Lens TypeAnnotation (Maybe Text)
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens TypeAnnotation -> Maybe Text
typeAnnotationValue (\TypeAnnotation
s Maybe Text
a -> TypeAnnotation
s { typeAnnotationValue = a })

class HasAnnotations t where
    annotations :: Lens t [TypeAnnotation]

-- | Docstrings are Javadoc-style comments attached various defined objects.
--
-- > /**
-- >  * Fetches an item.
-- >  */
-- > Item getItem()
type Docstring = Maybe Text

class HasDocstring t where
    docstring :: Lens t Docstring

-- | A constant literal value in the IDL. Only a few basic types, lists, and
-- maps can be presented in Thrift files as literals.
--
-- Constants are used for IDL-level constants and default values for fields.
data ConstValue srcAnnot
    = ConstInt Integer srcAnnot
    -- ^ An integer. @42@
    | ConstFloat Double srcAnnot
    -- ^ A float. @4.2@
    | ConstLiteral Text srcAnnot
    -- ^ A literal string. @"hello"@
    | ConstIdentifier Text srcAnnot
    -- ^ A reference to another constant. @Foo.bar@
    | ConstList [ConstValue srcAnnot] srcAnnot
    -- ^ A literal list containing other constant values. @[42]@
    | ConstMap [(ConstValue srcAnnot, ConstValue srcAnnot)] srcAnnot
    -- ^ A literal list containing other constant values.
    -- @{"hellO": 1, "world": 2}@
  deriving (Int -> ConstValue srcAnnot -> ShowS
[ConstValue srcAnnot] -> ShowS
ConstValue srcAnnot -> String
(Int -> ConstValue srcAnnot -> ShowS)
-> (ConstValue srcAnnot -> String)
-> ([ConstValue srcAnnot] -> ShowS)
-> Show (ConstValue srcAnnot)
forall srcAnnot.
Show srcAnnot =>
Int -> ConstValue srcAnnot -> ShowS
forall srcAnnot. Show srcAnnot => [ConstValue srcAnnot] -> ShowS
forall srcAnnot. Show srcAnnot => ConstValue srcAnnot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall srcAnnot.
Show srcAnnot =>
Int -> ConstValue srcAnnot -> ShowS
showsPrec :: Int -> ConstValue srcAnnot -> ShowS
$cshow :: forall srcAnnot. Show srcAnnot => ConstValue srcAnnot -> String
show :: ConstValue srcAnnot -> String
$cshowList :: forall srcAnnot. Show srcAnnot => [ConstValue srcAnnot] -> ShowS
showList :: [ConstValue srcAnnot] -> ShowS
Show, Eq (ConstValue srcAnnot)
Eq (ConstValue srcAnnot) =>
(ConstValue srcAnnot -> ConstValue srcAnnot -> Ordering)
-> (ConstValue srcAnnot -> ConstValue srcAnnot -> Bool)
-> (ConstValue srcAnnot -> ConstValue srcAnnot -> Bool)
-> (ConstValue srcAnnot -> ConstValue srcAnnot -> Bool)
-> (ConstValue srcAnnot -> ConstValue srcAnnot -> Bool)
-> (ConstValue srcAnnot
    -> ConstValue srcAnnot -> ConstValue srcAnnot)
-> (ConstValue srcAnnot
    -> ConstValue srcAnnot -> ConstValue srcAnnot)
-> Ord (ConstValue srcAnnot)
ConstValue srcAnnot -> ConstValue srcAnnot -> Bool
ConstValue srcAnnot -> ConstValue srcAnnot -> Ordering
ConstValue srcAnnot -> ConstValue srcAnnot -> ConstValue srcAnnot
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 srcAnnot. Ord srcAnnot => Eq (ConstValue srcAnnot)
forall srcAnnot.
Ord srcAnnot =>
ConstValue srcAnnot -> ConstValue srcAnnot -> Bool
forall srcAnnot.
Ord srcAnnot =>
ConstValue srcAnnot -> ConstValue srcAnnot -> Ordering
forall srcAnnot.
Ord srcAnnot =>
ConstValue srcAnnot -> ConstValue srcAnnot -> ConstValue srcAnnot
$ccompare :: forall srcAnnot.
Ord srcAnnot =>
ConstValue srcAnnot -> ConstValue srcAnnot -> Ordering
compare :: ConstValue srcAnnot -> ConstValue srcAnnot -> Ordering
$c< :: forall srcAnnot.
Ord srcAnnot =>
ConstValue srcAnnot -> ConstValue srcAnnot -> Bool
< :: ConstValue srcAnnot -> ConstValue srcAnnot -> Bool
$c<= :: forall srcAnnot.
Ord srcAnnot =>
ConstValue srcAnnot -> ConstValue srcAnnot -> Bool
<= :: ConstValue srcAnnot -> ConstValue srcAnnot -> Bool
$c> :: forall srcAnnot.
Ord srcAnnot =>
ConstValue srcAnnot -> ConstValue srcAnnot -> Bool
> :: ConstValue srcAnnot -> ConstValue srcAnnot -> Bool
$c>= :: forall srcAnnot.
Ord srcAnnot =>
ConstValue srcAnnot -> ConstValue srcAnnot -> Bool
>= :: ConstValue srcAnnot -> ConstValue srcAnnot -> Bool
$cmax :: forall srcAnnot.
Ord srcAnnot =>
ConstValue srcAnnot -> ConstValue srcAnnot -> ConstValue srcAnnot
max :: ConstValue srcAnnot -> ConstValue srcAnnot -> ConstValue srcAnnot
$cmin :: forall srcAnnot.
Ord srcAnnot =>
ConstValue srcAnnot -> ConstValue srcAnnot -> ConstValue srcAnnot
min :: ConstValue srcAnnot -> ConstValue srcAnnot -> ConstValue srcAnnot
Ord, ConstValue srcAnnot -> ConstValue srcAnnot -> Bool
(ConstValue srcAnnot -> ConstValue srcAnnot -> Bool)
-> (ConstValue srcAnnot -> ConstValue srcAnnot -> Bool)
-> Eq (ConstValue srcAnnot)
forall srcAnnot.
Eq srcAnnot =>
ConstValue srcAnnot -> ConstValue srcAnnot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall srcAnnot.
Eq srcAnnot =>
ConstValue srcAnnot -> ConstValue srcAnnot -> Bool
== :: ConstValue srcAnnot -> ConstValue srcAnnot -> Bool
$c/= :: forall srcAnnot.
Eq srcAnnot =>
ConstValue srcAnnot -> ConstValue srcAnnot -> Bool
/= :: ConstValue srcAnnot -> ConstValue srcAnnot -> Bool
Eq, Typeable (ConstValue srcAnnot)
Typeable (ConstValue srcAnnot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> ConstValue srcAnnot
 -> c (ConstValue srcAnnot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (ConstValue srcAnnot))
-> (ConstValue srcAnnot -> Constr)
-> (ConstValue srcAnnot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (ConstValue srcAnnot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (ConstValue srcAnnot)))
-> ((forall b. Data b => b -> b)
    -> ConstValue srcAnnot -> ConstValue srcAnnot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ConstValue srcAnnot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ConstValue srcAnnot -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ConstValue srcAnnot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ConstValue srcAnnot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ConstValue srcAnnot -> m (ConstValue srcAnnot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ConstValue srcAnnot -> m (ConstValue srcAnnot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ConstValue srcAnnot -> m (ConstValue srcAnnot))
-> Data (ConstValue srcAnnot)
ConstValue srcAnnot -> Constr
ConstValue srcAnnot -> DataType
(forall b. Data b => b -> b)
-> ConstValue srcAnnot -> ConstValue srcAnnot
forall srcAnnot. Data srcAnnot => Typeable (ConstValue srcAnnot)
forall srcAnnot. Data srcAnnot => ConstValue srcAnnot -> Constr
forall srcAnnot. Data srcAnnot => ConstValue srcAnnot -> DataType
forall srcAnnot.
Data srcAnnot =>
(forall b. Data b => b -> b)
-> ConstValue srcAnnot -> ConstValue srcAnnot
forall srcAnnot u.
Data srcAnnot =>
Int -> (forall d. Data d => d -> u) -> ConstValue srcAnnot -> u
forall srcAnnot u.
Data srcAnnot =>
(forall d. Data d => d -> u) -> ConstValue srcAnnot -> [u]
forall srcAnnot r r'.
Data srcAnnot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ConstValue srcAnnot -> r
forall srcAnnot r r'.
Data srcAnnot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ConstValue srcAnnot -> r
forall srcAnnot (m :: * -> *).
(Data srcAnnot, Monad m) =>
(forall d. Data d => d -> m d)
-> ConstValue srcAnnot -> m (ConstValue srcAnnot)
forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ConstValue srcAnnot -> m (ConstValue srcAnnot)
forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ConstValue srcAnnot)
forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ConstValue srcAnnot
-> c (ConstValue srcAnnot)
forall srcAnnot (t :: * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (ConstValue srcAnnot))
forall srcAnnot (t :: * -> * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ConstValue srcAnnot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ConstValue srcAnnot -> u
forall u.
(forall d. Data d => d -> u) -> ConstValue srcAnnot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ConstValue srcAnnot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ConstValue srcAnnot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ConstValue srcAnnot -> m (ConstValue srcAnnot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ConstValue srcAnnot -> m (ConstValue srcAnnot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ConstValue srcAnnot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ConstValue srcAnnot
-> c (ConstValue srcAnnot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (ConstValue srcAnnot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ConstValue srcAnnot))
$cgfoldl :: forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ConstValue srcAnnot
-> c (ConstValue srcAnnot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ConstValue srcAnnot
-> c (ConstValue srcAnnot)
$cgunfold :: forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ConstValue srcAnnot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ConstValue srcAnnot)
$ctoConstr :: forall srcAnnot. Data srcAnnot => ConstValue srcAnnot -> Constr
toConstr :: ConstValue srcAnnot -> Constr
$cdataTypeOf :: forall srcAnnot. Data srcAnnot => ConstValue srcAnnot -> DataType
dataTypeOf :: ConstValue srcAnnot -> DataType
$cdataCast1 :: forall srcAnnot (t :: * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (ConstValue srcAnnot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (ConstValue srcAnnot))
$cdataCast2 :: forall srcAnnot (t :: * -> * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ConstValue srcAnnot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ConstValue srcAnnot))
$cgmapT :: forall srcAnnot.
Data srcAnnot =>
(forall b. Data b => b -> b)
-> ConstValue srcAnnot -> ConstValue srcAnnot
gmapT :: (forall b. Data b => b -> b)
-> ConstValue srcAnnot -> ConstValue srcAnnot
$cgmapQl :: forall srcAnnot r r'.
Data srcAnnot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ConstValue srcAnnot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ConstValue srcAnnot -> r
$cgmapQr :: forall srcAnnot r r'.
Data srcAnnot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ConstValue srcAnnot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ConstValue srcAnnot -> r
$cgmapQ :: forall srcAnnot u.
Data srcAnnot =>
(forall d. Data d => d -> u) -> ConstValue srcAnnot -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> ConstValue srcAnnot -> [u]
$cgmapQi :: forall srcAnnot u.
Data srcAnnot =>
Int -> (forall d. Data d => d -> u) -> ConstValue srcAnnot -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ConstValue srcAnnot -> u
$cgmapM :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, Monad m) =>
(forall d. Data d => d -> m d)
-> ConstValue srcAnnot -> m (ConstValue srcAnnot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ConstValue srcAnnot -> m (ConstValue srcAnnot)
$cgmapMp :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ConstValue srcAnnot -> m (ConstValue srcAnnot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ConstValue srcAnnot -> m (ConstValue srcAnnot)
$cgmapMo :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ConstValue srcAnnot -> m (ConstValue srcAnnot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ConstValue srcAnnot -> m (ConstValue srcAnnot)
Data, Typeable, (forall x. ConstValue srcAnnot -> Rep (ConstValue srcAnnot) x)
-> (forall x. Rep (ConstValue srcAnnot) x -> ConstValue srcAnnot)
-> Generic (ConstValue srcAnnot)
forall x. Rep (ConstValue srcAnnot) x -> ConstValue srcAnnot
forall x. ConstValue srcAnnot -> Rep (ConstValue srcAnnot) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall srcAnnot x.
Rep (ConstValue srcAnnot) x -> ConstValue srcAnnot
forall srcAnnot x.
ConstValue srcAnnot -> Rep (ConstValue srcAnnot) x
$cfrom :: forall srcAnnot x.
ConstValue srcAnnot -> Rep (ConstValue srcAnnot) x
from :: forall x. ConstValue srcAnnot -> Rep (ConstValue srcAnnot) x
$cto :: forall srcAnnot x.
Rep (ConstValue srcAnnot) x -> ConstValue srcAnnot
to :: forall x. Rep (ConstValue srcAnnot) x -> ConstValue srcAnnot
Generic, (forall a b. (a -> b) -> ConstValue a -> ConstValue b)
-> (forall a b. a -> ConstValue b -> ConstValue a)
-> Functor ConstValue
forall a b. a -> ConstValue b -> ConstValue a
forall a b. (a -> b) -> ConstValue a -> ConstValue b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ConstValue a -> ConstValue b
fmap :: forall a b. (a -> b) -> ConstValue a -> ConstValue b
$c<$ :: forall a b. a -> ConstValue b -> ConstValue a
<$ :: forall a b. a -> ConstValue b -> ConstValue a
Functor)

instance HasSrcAnnot ConstValue where
    srcAnnot :: forall a. Lens (ConstValue a) a
srcAnnot = (ConstValue a -> a)
-> (ConstValue a -> a -> ConstValue a) -> Lens (ConstValue a) a
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens ConstValue a -> a
forall {srcAnnot}. ConstValue srcAnnot -> srcAnnot
getter ConstValue a -> a -> ConstValue a
forall {srcAnnot}.
ConstValue srcAnnot -> srcAnnot -> ConstValue srcAnnot
setter
      where
        getter :: ConstValue srcAnnot -> srcAnnot
getter (ConstInt        Integer
_ srcAnnot
a) = srcAnnot
a
        getter (ConstFloat      Double
_ srcAnnot
a) = srcAnnot
a
        getter (ConstLiteral    Text
_ srcAnnot
a) = srcAnnot
a
        getter (ConstIdentifier Text
_ srcAnnot
a) = srcAnnot
a
        getter (ConstList       [ConstValue srcAnnot]
_ srcAnnot
a) = srcAnnot
a
        getter (ConstMap        [(ConstValue srcAnnot, ConstValue srcAnnot)]
_ srcAnnot
a) = srcAnnot
a

        setter :: ConstValue srcAnnot -> srcAnnot -> ConstValue srcAnnot
setter (ConstInt        Integer
x srcAnnot
_) srcAnnot
a = Integer -> srcAnnot -> ConstValue srcAnnot
forall srcAnnot. Integer -> srcAnnot -> ConstValue srcAnnot
ConstInt        Integer
x srcAnnot
a
        setter (ConstFloat      Double
x srcAnnot
_) srcAnnot
a = Double -> srcAnnot -> ConstValue srcAnnot
forall srcAnnot. Double -> srcAnnot -> ConstValue srcAnnot
ConstFloat      Double
x srcAnnot
a
        setter (ConstLiteral    Text
x srcAnnot
_) srcAnnot
a = Text -> srcAnnot -> ConstValue srcAnnot
forall srcAnnot. Text -> srcAnnot -> ConstValue srcAnnot
ConstLiteral    Text
x srcAnnot
a
        setter (ConstIdentifier Text
x srcAnnot
_) srcAnnot
a = Text -> srcAnnot -> ConstValue srcAnnot
forall srcAnnot. Text -> srcAnnot -> ConstValue srcAnnot
ConstIdentifier Text
x srcAnnot
a
        setter (ConstList       [ConstValue srcAnnot]
x srcAnnot
_) srcAnnot
a = [ConstValue srcAnnot] -> srcAnnot -> ConstValue srcAnnot
forall srcAnnot.
[ConstValue srcAnnot] -> srcAnnot -> ConstValue srcAnnot
ConstList       [ConstValue srcAnnot]
x srcAnnot
a
        setter (ConstMap        [(ConstValue srcAnnot, ConstValue srcAnnot)]
x srcAnnot
_) srcAnnot
a = [(ConstValue srcAnnot, ConstValue srcAnnot)]
-> srcAnnot -> ConstValue srcAnnot
forall srcAnnot.
[(ConstValue srcAnnot, ConstValue srcAnnot)]
-> srcAnnot -> ConstValue srcAnnot
ConstMap        [(ConstValue srcAnnot, ConstValue srcAnnot)]
x srcAnnot
a

-- | A reference to a type.
data TypeReference srcAnnot
    = DefinedType Text srcAnnot
    -- ^ A custom defined type referred to by name.

    | StringType [TypeAnnotation] srcAnnot
    -- ^ @string@ and annotations.
    | BinaryType [TypeAnnotation] srcAnnot
    -- ^ @binary@ and annotations.
    | SListType [TypeAnnotation] srcAnnot
    -- ^ @slist@ and annotations.
    | BoolType [TypeAnnotation] srcAnnot
    -- ^ @bool@ and annotations.
    | ByteType [TypeAnnotation] srcAnnot
    -- ^ @byte@ and annotations.
    | I16Type [TypeAnnotation] srcAnnot
    -- ^ @i16@ and annotations.
    | I32Type [TypeAnnotation] srcAnnot
    -- ^ @i32@ and annotations.
    | I64Type [TypeAnnotation] srcAnnot
    -- ^ @i64@ and annotations.
    | DoubleType [TypeAnnotation] srcAnnot
    -- ^ @double@ and annotations.

    -- Container types
    | MapType
        (TypeReference srcAnnot)
        (TypeReference srcAnnot)
        [TypeAnnotation]
        srcAnnot
    -- ^ @map\<foo, bar\>@ and annotations.
    | SetType (TypeReference srcAnnot) [TypeAnnotation] srcAnnot
    -- ^ @set\<baz\>@ and annotations.
    | ListType (TypeReference srcAnnot) [TypeAnnotation] srcAnnot
    -- ^ @list\<qux\>@ and annotations.
  deriving (Int -> TypeReference srcAnnot -> ShowS
[TypeReference srcAnnot] -> ShowS
TypeReference srcAnnot -> String
(Int -> TypeReference srcAnnot -> ShowS)
-> (TypeReference srcAnnot -> String)
-> ([TypeReference srcAnnot] -> ShowS)
-> Show (TypeReference srcAnnot)
forall srcAnnot.
Show srcAnnot =>
Int -> TypeReference srcAnnot -> ShowS
forall srcAnnot. Show srcAnnot => [TypeReference srcAnnot] -> ShowS
forall srcAnnot. Show srcAnnot => TypeReference srcAnnot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall srcAnnot.
Show srcAnnot =>
Int -> TypeReference srcAnnot -> ShowS
showsPrec :: Int -> TypeReference srcAnnot -> ShowS
$cshow :: forall srcAnnot. Show srcAnnot => TypeReference srcAnnot -> String
show :: TypeReference srcAnnot -> String
$cshowList :: forall srcAnnot. Show srcAnnot => [TypeReference srcAnnot] -> ShowS
showList :: [TypeReference srcAnnot] -> ShowS
Show, Eq (TypeReference srcAnnot)
Eq (TypeReference srcAnnot) =>
(TypeReference srcAnnot -> TypeReference srcAnnot -> Ordering)
-> (TypeReference srcAnnot -> TypeReference srcAnnot -> Bool)
-> (TypeReference srcAnnot -> TypeReference srcAnnot -> Bool)
-> (TypeReference srcAnnot -> TypeReference srcAnnot -> Bool)
-> (TypeReference srcAnnot -> TypeReference srcAnnot -> Bool)
-> (TypeReference srcAnnot
    -> TypeReference srcAnnot -> TypeReference srcAnnot)
-> (TypeReference srcAnnot
    -> TypeReference srcAnnot -> TypeReference srcAnnot)
-> Ord (TypeReference srcAnnot)
TypeReference srcAnnot -> TypeReference srcAnnot -> Bool
TypeReference srcAnnot -> TypeReference srcAnnot -> Ordering
TypeReference srcAnnot
-> TypeReference srcAnnot -> TypeReference srcAnnot
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 srcAnnot. Ord srcAnnot => Eq (TypeReference srcAnnot)
forall srcAnnot.
Ord srcAnnot =>
TypeReference srcAnnot -> TypeReference srcAnnot -> Bool
forall srcAnnot.
Ord srcAnnot =>
TypeReference srcAnnot -> TypeReference srcAnnot -> Ordering
forall srcAnnot.
Ord srcAnnot =>
TypeReference srcAnnot
-> TypeReference srcAnnot -> TypeReference srcAnnot
$ccompare :: forall srcAnnot.
Ord srcAnnot =>
TypeReference srcAnnot -> TypeReference srcAnnot -> Ordering
compare :: TypeReference srcAnnot -> TypeReference srcAnnot -> Ordering
$c< :: forall srcAnnot.
Ord srcAnnot =>
TypeReference srcAnnot -> TypeReference srcAnnot -> Bool
< :: TypeReference srcAnnot -> TypeReference srcAnnot -> Bool
$c<= :: forall srcAnnot.
Ord srcAnnot =>
TypeReference srcAnnot -> TypeReference srcAnnot -> Bool
<= :: TypeReference srcAnnot -> TypeReference srcAnnot -> Bool
$c> :: forall srcAnnot.
Ord srcAnnot =>
TypeReference srcAnnot -> TypeReference srcAnnot -> Bool
> :: TypeReference srcAnnot -> TypeReference srcAnnot -> Bool
$c>= :: forall srcAnnot.
Ord srcAnnot =>
TypeReference srcAnnot -> TypeReference srcAnnot -> Bool
>= :: TypeReference srcAnnot -> TypeReference srcAnnot -> Bool
$cmax :: forall srcAnnot.
Ord srcAnnot =>
TypeReference srcAnnot
-> TypeReference srcAnnot -> TypeReference srcAnnot
max :: TypeReference srcAnnot
-> TypeReference srcAnnot -> TypeReference srcAnnot
$cmin :: forall srcAnnot.
Ord srcAnnot =>
TypeReference srcAnnot
-> TypeReference srcAnnot -> TypeReference srcAnnot
min :: TypeReference srcAnnot
-> TypeReference srcAnnot -> TypeReference srcAnnot
Ord, TypeReference srcAnnot -> TypeReference srcAnnot -> Bool
(TypeReference srcAnnot -> TypeReference srcAnnot -> Bool)
-> (TypeReference srcAnnot -> TypeReference srcAnnot -> Bool)
-> Eq (TypeReference srcAnnot)
forall srcAnnot.
Eq srcAnnot =>
TypeReference srcAnnot -> TypeReference srcAnnot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall srcAnnot.
Eq srcAnnot =>
TypeReference srcAnnot -> TypeReference srcAnnot -> Bool
== :: TypeReference srcAnnot -> TypeReference srcAnnot -> Bool
$c/= :: forall srcAnnot.
Eq srcAnnot =>
TypeReference srcAnnot -> TypeReference srcAnnot -> Bool
/= :: TypeReference srcAnnot -> TypeReference srcAnnot -> Bool
Eq, Typeable (TypeReference srcAnnot)
Typeable (TypeReference srcAnnot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> TypeReference srcAnnot
 -> c (TypeReference srcAnnot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (TypeReference srcAnnot))
-> (TypeReference srcAnnot -> Constr)
-> (TypeReference srcAnnot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d))
    -> Maybe (c (TypeReference srcAnnot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (TypeReference srcAnnot)))
-> ((forall b. Data b => b -> b)
    -> TypeReference srcAnnot -> TypeReference srcAnnot)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> TypeReference srcAnnot
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> TypeReference srcAnnot
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> TypeReference srcAnnot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> TypeReference srcAnnot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> TypeReference srcAnnot -> m (TypeReference srcAnnot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> TypeReference srcAnnot -> m (TypeReference srcAnnot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> TypeReference srcAnnot -> m (TypeReference srcAnnot))
-> Data (TypeReference srcAnnot)
TypeReference srcAnnot -> Constr
TypeReference srcAnnot -> DataType
(forall b. Data b => b -> b)
-> TypeReference srcAnnot -> TypeReference srcAnnot
forall srcAnnot. Data srcAnnot => Typeable (TypeReference srcAnnot)
forall srcAnnot. Data srcAnnot => TypeReference srcAnnot -> Constr
forall srcAnnot.
Data srcAnnot =>
TypeReference srcAnnot -> DataType
forall srcAnnot.
Data srcAnnot =>
(forall b. Data b => b -> b)
-> TypeReference srcAnnot -> TypeReference srcAnnot
forall srcAnnot u.
Data srcAnnot =>
Int -> (forall d. Data d => d -> u) -> TypeReference srcAnnot -> u
forall srcAnnot u.
Data srcAnnot =>
(forall d. Data d => d -> u) -> TypeReference srcAnnot -> [u]
forall srcAnnot r r'.
Data srcAnnot =>
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> TypeReference srcAnnot
-> r
forall srcAnnot r r'.
Data srcAnnot =>
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> TypeReference srcAnnot
-> r
forall srcAnnot (m :: * -> *).
(Data srcAnnot, Monad m) =>
(forall d. Data d => d -> m d)
-> TypeReference srcAnnot -> m (TypeReference srcAnnot)
forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> TypeReference srcAnnot -> m (TypeReference srcAnnot)
forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (TypeReference srcAnnot)
forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> TypeReference srcAnnot
-> c (TypeReference srcAnnot)
forall srcAnnot (t :: * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (TypeReference srcAnnot))
forall srcAnnot (t :: * -> * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (TypeReference srcAnnot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> TypeReference srcAnnot -> u
forall u.
(forall d. Data d => d -> u) -> TypeReference srcAnnot -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> TypeReference srcAnnot
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> TypeReference srcAnnot
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TypeReference srcAnnot -> m (TypeReference srcAnnot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TypeReference srcAnnot -> m (TypeReference srcAnnot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (TypeReference srcAnnot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> TypeReference srcAnnot
-> c (TypeReference srcAnnot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (TypeReference srcAnnot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (TypeReference srcAnnot))
$cgfoldl :: forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> TypeReference srcAnnot
-> c (TypeReference srcAnnot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> TypeReference srcAnnot
-> c (TypeReference srcAnnot)
$cgunfold :: forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (TypeReference srcAnnot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (TypeReference srcAnnot)
$ctoConstr :: forall srcAnnot. Data srcAnnot => TypeReference srcAnnot -> Constr
toConstr :: TypeReference srcAnnot -> Constr
$cdataTypeOf :: forall srcAnnot.
Data srcAnnot =>
TypeReference srcAnnot -> DataType
dataTypeOf :: TypeReference srcAnnot -> DataType
$cdataCast1 :: forall srcAnnot (t :: * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (TypeReference srcAnnot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (TypeReference srcAnnot))
$cdataCast2 :: forall srcAnnot (t :: * -> * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (TypeReference srcAnnot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (TypeReference srcAnnot))
$cgmapT :: forall srcAnnot.
Data srcAnnot =>
(forall b. Data b => b -> b)
-> TypeReference srcAnnot -> TypeReference srcAnnot
gmapT :: (forall b. Data b => b -> b)
-> TypeReference srcAnnot -> TypeReference srcAnnot
$cgmapQl :: forall srcAnnot r r'.
Data srcAnnot =>
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> TypeReference srcAnnot
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> TypeReference srcAnnot
-> r
$cgmapQr :: forall srcAnnot r r'.
Data srcAnnot =>
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> TypeReference srcAnnot
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> TypeReference srcAnnot
-> r
$cgmapQ :: forall srcAnnot u.
Data srcAnnot =>
(forall d. Data d => d -> u) -> TypeReference srcAnnot -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> TypeReference srcAnnot -> [u]
$cgmapQi :: forall srcAnnot u.
Data srcAnnot =>
Int -> (forall d. Data d => d -> u) -> TypeReference srcAnnot -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> TypeReference srcAnnot -> u
$cgmapM :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, Monad m) =>
(forall d. Data d => d -> m d)
-> TypeReference srcAnnot -> m (TypeReference srcAnnot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TypeReference srcAnnot -> m (TypeReference srcAnnot)
$cgmapMp :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> TypeReference srcAnnot -> m (TypeReference srcAnnot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TypeReference srcAnnot -> m (TypeReference srcAnnot)
$cgmapMo :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> TypeReference srcAnnot -> m (TypeReference srcAnnot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TypeReference srcAnnot -> m (TypeReference srcAnnot)
Data, Typeable, (forall x.
 TypeReference srcAnnot -> Rep (TypeReference srcAnnot) x)
-> (forall x.
    Rep (TypeReference srcAnnot) x -> TypeReference srcAnnot)
-> Generic (TypeReference srcAnnot)
forall x. Rep (TypeReference srcAnnot) x -> TypeReference srcAnnot
forall x. TypeReference srcAnnot -> Rep (TypeReference srcAnnot) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall srcAnnot x.
Rep (TypeReference srcAnnot) x -> TypeReference srcAnnot
forall srcAnnot x.
TypeReference srcAnnot -> Rep (TypeReference srcAnnot) x
$cfrom :: forall srcAnnot x.
TypeReference srcAnnot -> Rep (TypeReference srcAnnot) x
from :: forall x. TypeReference srcAnnot -> Rep (TypeReference srcAnnot) x
$cto :: forall srcAnnot x.
Rep (TypeReference srcAnnot) x -> TypeReference srcAnnot
to :: forall x. Rep (TypeReference srcAnnot) x -> TypeReference srcAnnot
Generic, (forall a b. (a -> b) -> TypeReference a -> TypeReference b)
-> (forall a b. a -> TypeReference b -> TypeReference a)
-> Functor TypeReference
forall a b. a -> TypeReference b -> TypeReference a
forall a b. (a -> b) -> TypeReference a -> TypeReference b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> TypeReference a -> TypeReference b
fmap :: forall a b. (a -> b) -> TypeReference a -> TypeReference b
$c<$ :: forall a b. a -> TypeReference b -> TypeReference a
<$ :: forall a b. a -> TypeReference b -> TypeReference a
Functor)

instance HasSrcAnnot TypeReference where
    srcAnnot :: forall a. Lens (TypeReference a) a
srcAnnot = (TypeReference a -> a)
-> (TypeReference a -> a -> TypeReference a)
-> Lens (TypeReference a) a
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens TypeReference a -> a
forall {srcAnnot}. TypeReference srcAnnot -> srcAnnot
getter TypeReference a -> a -> TypeReference a
forall {srcAnnot}.
TypeReference srcAnnot -> srcAnnot -> TypeReference srcAnnot
setter
      where
        getter :: TypeReference srcAnnot -> srcAnnot
getter (DefinedType Text
_ srcAnnot
a) = srcAnnot
a
        getter (StringType  [TypeAnnotation]
_ srcAnnot
a) = srcAnnot
a
        getter (BinaryType  [TypeAnnotation]
_ srcAnnot
a) = srcAnnot
a
        getter (SListType   [TypeAnnotation]
_ srcAnnot
a) = srcAnnot
a
        getter (BoolType    [TypeAnnotation]
_ srcAnnot
a) = srcAnnot
a
        getter (ByteType    [TypeAnnotation]
_ srcAnnot
a) = srcAnnot
a
        getter (I16Type     [TypeAnnotation]
_ srcAnnot
a) = srcAnnot
a
        getter (I32Type     [TypeAnnotation]
_ srcAnnot
a) = srcAnnot
a
        getter (I64Type     [TypeAnnotation]
_ srcAnnot
a) = srcAnnot
a
        getter (DoubleType  [TypeAnnotation]
_ srcAnnot
a) = srcAnnot
a
        getter (MapType TypeReference srcAnnot
_ TypeReference srcAnnot
_ [TypeAnnotation]
_ srcAnnot
a) = srcAnnot
a
        getter (SetType   TypeReference srcAnnot
_ [TypeAnnotation]
_ srcAnnot
a) = srcAnnot
a
        getter (ListType  TypeReference srcAnnot
_ [TypeAnnotation]
_ srcAnnot
a) = srcAnnot
a

        setter :: TypeReference srcAnnot -> srcAnnot -> TypeReference srcAnnot
setter (DefinedType Text
x srcAnnot
_) srcAnnot
a = Text -> srcAnnot -> TypeReference srcAnnot
forall srcAnnot. Text -> srcAnnot -> TypeReference srcAnnot
DefinedType Text
x srcAnnot
a
        setter (StringType  [TypeAnnotation]
x srcAnnot
_) srcAnnot
a = [TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
forall srcAnnot.
[TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
StringType  [TypeAnnotation]
x srcAnnot
a
        setter (BinaryType  [TypeAnnotation]
x srcAnnot
_) srcAnnot
a = [TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
forall srcAnnot.
[TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
BinaryType  [TypeAnnotation]
x srcAnnot
a
        setter (SListType   [TypeAnnotation]
x srcAnnot
_) srcAnnot
a = [TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
forall srcAnnot.
[TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
SListType   [TypeAnnotation]
x srcAnnot
a
        setter (BoolType    [TypeAnnotation]
x srcAnnot
_) srcAnnot
a = [TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
forall srcAnnot.
[TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
BoolType    [TypeAnnotation]
x srcAnnot
a
        setter (ByteType    [TypeAnnotation]
x srcAnnot
_) srcAnnot
a = [TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
forall srcAnnot.
[TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
ByteType    [TypeAnnotation]
x srcAnnot
a
        setter (I16Type     [TypeAnnotation]
x srcAnnot
_) srcAnnot
a = [TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
forall srcAnnot.
[TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
I16Type     [TypeAnnotation]
x srcAnnot
a
        setter (I32Type     [TypeAnnotation]
x srcAnnot
_) srcAnnot
a = [TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
forall srcAnnot.
[TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
I32Type     [TypeAnnotation]
x srcAnnot
a
        setter (I64Type     [TypeAnnotation]
x srcAnnot
_) srcAnnot
a = [TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
forall srcAnnot.
[TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
I64Type     [TypeAnnotation]
x srcAnnot
a
        setter (DoubleType  [TypeAnnotation]
x srcAnnot
_) srcAnnot
a = [TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
forall srcAnnot.
[TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
DoubleType  [TypeAnnotation]
x srcAnnot
a
        setter (MapType TypeReference srcAnnot
k TypeReference srcAnnot
v [TypeAnnotation]
x srcAnnot
_) srcAnnot
a = TypeReference srcAnnot
-> TypeReference srcAnnot
-> [TypeAnnotation]
-> srcAnnot
-> TypeReference srcAnnot
forall srcAnnot.
TypeReference srcAnnot
-> TypeReference srcAnnot
-> [TypeAnnotation]
-> srcAnnot
-> TypeReference srcAnnot
MapType TypeReference srcAnnot
k TypeReference srcAnnot
v [TypeAnnotation]
x srcAnnot
a
        setter (SetType   TypeReference srcAnnot
t [TypeAnnotation]
x srcAnnot
_) srcAnnot
a = TypeReference srcAnnot
-> [TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
forall srcAnnot.
TypeReference srcAnnot
-> [TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
SetType   TypeReference srcAnnot
t [TypeAnnotation]
x srcAnnot
a
        setter (ListType  TypeReference srcAnnot
t [TypeAnnotation]
x srcAnnot
_) srcAnnot
a = TypeReference srcAnnot
-> [TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
forall srcAnnot.
TypeReference srcAnnot
-> [TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
ListType  TypeReference srcAnnot
t [TypeAnnotation]
x srcAnnot
a

class HasValueType t where
    valueType :: Lens (t a) (TypeReference a)

-- | Whether a field is required or optional.
data FieldRequiredness
    = Required -- ^ The field is @required@.
    | Optional -- ^ The field is @optional@.
  deriving (Int -> FieldRequiredness -> ShowS
[FieldRequiredness] -> ShowS
FieldRequiredness -> String
(Int -> FieldRequiredness -> ShowS)
-> (FieldRequiredness -> String)
-> ([FieldRequiredness] -> ShowS)
-> Show FieldRequiredness
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FieldRequiredness -> ShowS
showsPrec :: Int -> FieldRequiredness -> ShowS
$cshow :: FieldRequiredness -> String
show :: FieldRequiredness -> String
$cshowList :: [FieldRequiredness] -> ShowS
showList :: [FieldRequiredness] -> ShowS
Show, Eq FieldRequiredness
Eq FieldRequiredness =>
(FieldRequiredness -> FieldRequiredness -> Ordering)
-> (FieldRequiredness -> FieldRequiredness -> Bool)
-> (FieldRequiredness -> FieldRequiredness -> Bool)
-> (FieldRequiredness -> FieldRequiredness -> Bool)
-> (FieldRequiredness -> FieldRequiredness -> Bool)
-> (FieldRequiredness -> FieldRequiredness -> FieldRequiredness)
-> (FieldRequiredness -> FieldRequiredness -> FieldRequiredness)
-> Ord FieldRequiredness
FieldRequiredness -> FieldRequiredness -> Bool
FieldRequiredness -> FieldRequiredness -> Ordering
FieldRequiredness -> FieldRequiredness -> FieldRequiredness
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FieldRequiredness -> FieldRequiredness -> Ordering
compare :: FieldRequiredness -> FieldRequiredness -> Ordering
$c< :: FieldRequiredness -> FieldRequiredness -> Bool
< :: FieldRequiredness -> FieldRequiredness -> Bool
$c<= :: FieldRequiredness -> FieldRequiredness -> Bool
<= :: FieldRequiredness -> FieldRequiredness -> Bool
$c> :: FieldRequiredness -> FieldRequiredness -> Bool
> :: FieldRequiredness -> FieldRequiredness -> Bool
$c>= :: FieldRequiredness -> FieldRequiredness -> Bool
>= :: FieldRequiredness -> FieldRequiredness -> Bool
$cmax :: FieldRequiredness -> FieldRequiredness -> FieldRequiredness
max :: FieldRequiredness -> FieldRequiredness -> FieldRequiredness
$cmin :: FieldRequiredness -> FieldRequiredness -> FieldRequiredness
min :: FieldRequiredness -> FieldRequiredness -> FieldRequiredness
Ord, FieldRequiredness -> FieldRequiredness -> Bool
(FieldRequiredness -> FieldRequiredness -> Bool)
-> (FieldRequiredness -> FieldRequiredness -> Bool)
-> Eq FieldRequiredness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FieldRequiredness -> FieldRequiredness -> Bool
== :: FieldRequiredness -> FieldRequiredness -> Bool
$c/= :: FieldRequiredness -> FieldRequiredness -> Bool
/= :: FieldRequiredness -> FieldRequiredness -> Bool
Eq, Typeable FieldRequiredness
Typeable FieldRequiredness =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> FieldRequiredness
 -> c FieldRequiredness)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FieldRequiredness)
-> (FieldRequiredness -> Constr)
-> (FieldRequiredness -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c FieldRequiredness))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c FieldRequiredness))
-> ((forall b. Data b => b -> b)
    -> FieldRequiredness -> FieldRequiredness)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FieldRequiredness -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FieldRequiredness -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> FieldRequiredness -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FieldRequiredness -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> FieldRequiredness -> m FieldRequiredness)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> FieldRequiredness -> m FieldRequiredness)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> FieldRequiredness -> m FieldRequiredness)
-> Data FieldRequiredness
FieldRequiredness -> Constr
FieldRequiredness -> DataType
(forall b. Data b => b -> b)
-> FieldRequiredness -> FieldRequiredness
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> FieldRequiredness -> u
forall u. (forall d. Data d => d -> u) -> FieldRequiredness -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FieldRequiredness -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FieldRequiredness -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FieldRequiredness -> m FieldRequiredness
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FieldRequiredness -> m FieldRequiredness
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FieldRequiredness
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FieldRequiredness -> c FieldRequiredness
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FieldRequiredness)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FieldRequiredness)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FieldRequiredness -> c FieldRequiredness
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FieldRequiredness -> c FieldRequiredness
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FieldRequiredness
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FieldRequiredness
$ctoConstr :: FieldRequiredness -> Constr
toConstr :: FieldRequiredness -> Constr
$cdataTypeOf :: FieldRequiredness -> DataType
dataTypeOf :: FieldRequiredness -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FieldRequiredness)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FieldRequiredness)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FieldRequiredness)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FieldRequiredness)
$cgmapT :: (forall b. Data b => b -> b)
-> FieldRequiredness -> FieldRequiredness
gmapT :: (forall b. Data b => b -> b)
-> FieldRequiredness -> FieldRequiredness
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FieldRequiredness -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FieldRequiredness -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FieldRequiredness -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FieldRequiredness -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FieldRequiredness -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> FieldRequiredness -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FieldRequiredness -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FieldRequiredness -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FieldRequiredness -> m FieldRequiredness
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FieldRequiredness -> m FieldRequiredness
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FieldRequiredness -> m FieldRequiredness
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FieldRequiredness -> m FieldRequiredness
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FieldRequiredness -> m FieldRequiredness
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FieldRequiredness -> m FieldRequiredness
Data, Typeable, (forall x. FieldRequiredness -> Rep FieldRequiredness x)
-> (forall x. Rep FieldRequiredness x -> FieldRequiredness)
-> Generic FieldRequiredness
forall x. Rep FieldRequiredness x -> FieldRequiredness
forall x. FieldRequiredness -> Rep FieldRequiredness x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FieldRequiredness -> Rep FieldRequiredness x
from :: forall x. FieldRequiredness -> Rep FieldRequiredness x
$cto :: forall x. Rep FieldRequiredness x -> FieldRequiredness
to :: forall x. Rep FieldRequiredness x -> FieldRequiredness
Generic)

-- | A field inside a struct, exception, or function parameters list.
data Field srcAnnot = Field
    { forall srcAnnot. Field srcAnnot -> Maybe Integer
fieldIdentifier   :: Maybe Integer
    -- ^ Position of the field.
    --
    -- While this is optional, it is recommended that Thrift files always
    -- contain specific field IDs.
    , forall srcAnnot. Field srcAnnot -> Maybe FieldRequiredness
fieldRequiredness :: Maybe FieldRequiredness
    -- ^ Whether this field is required or not.
    --
    -- Behavior may differ between languages if requiredness is not specified.
    -- Therefore it's recommended that requiredness for a field is always
    -- specified.
    , forall srcAnnot. Field srcAnnot -> TypeReference srcAnnot
fieldValueType    :: TypeReference srcAnnot
    -- ^ Type of value the field holds.
    , forall srcAnnot. Field srcAnnot -> Text
fieldName         :: Text
    -- ^ Name of the field.
    , forall srcAnnot. Field srcAnnot -> Maybe (ConstValue srcAnnot)
fieldDefaultValue :: Maybe (ConstValue srcAnnot)
    -- ^ Default value of the field, if any.
    , forall srcAnnot. Field srcAnnot -> [TypeAnnotation]
fieldAnnotations  :: [TypeAnnotation]
    -- ^ Field annotations.
    , forall srcAnnot. Field srcAnnot -> Maybe Text
fieldDocstring    :: Docstring
    -- ^ Documentation.
    , forall srcAnnot. Field srcAnnot -> srcAnnot
fieldSrcAnnot     :: srcAnnot
    }
  deriving (Int -> Field srcAnnot -> ShowS
[Field srcAnnot] -> ShowS
Field srcAnnot -> String
(Int -> Field srcAnnot -> ShowS)
-> (Field srcAnnot -> String)
-> ([Field srcAnnot] -> ShowS)
-> Show (Field srcAnnot)
forall srcAnnot. Show srcAnnot => Int -> Field srcAnnot -> ShowS
forall srcAnnot. Show srcAnnot => [Field srcAnnot] -> ShowS
forall srcAnnot. Show srcAnnot => Field srcAnnot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall srcAnnot. Show srcAnnot => Int -> Field srcAnnot -> ShowS
showsPrec :: Int -> Field srcAnnot -> ShowS
$cshow :: forall srcAnnot. Show srcAnnot => Field srcAnnot -> String
show :: Field srcAnnot -> String
$cshowList :: forall srcAnnot. Show srcAnnot => [Field srcAnnot] -> ShowS
showList :: [Field srcAnnot] -> ShowS
Show, Eq (Field srcAnnot)
Eq (Field srcAnnot) =>
(Field srcAnnot -> Field srcAnnot -> Ordering)
-> (Field srcAnnot -> Field srcAnnot -> Bool)
-> (Field srcAnnot -> Field srcAnnot -> Bool)
-> (Field srcAnnot -> Field srcAnnot -> Bool)
-> (Field srcAnnot -> Field srcAnnot -> Bool)
-> (Field srcAnnot -> Field srcAnnot -> Field srcAnnot)
-> (Field srcAnnot -> Field srcAnnot -> Field srcAnnot)
-> Ord (Field srcAnnot)
Field srcAnnot -> Field srcAnnot -> Bool
Field srcAnnot -> Field srcAnnot -> Ordering
Field srcAnnot -> Field srcAnnot -> Field srcAnnot
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 srcAnnot. Ord srcAnnot => Eq (Field srcAnnot)
forall srcAnnot.
Ord srcAnnot =>
Field srcAnnot -> Field srcAnnot -> Bool
forall srcAnnot.
Ord srcAnnot =>
Field srcAnnot -> Field srcAnnot -> Ordering
forall srcAnnot.
Ord srcAnnot =>
Field srcAnnot -> Field srcAnnot -> Field srcAnnot
$ccompare :: forall srcAnnot.
Ord srcAnnot =>
Field srcAnnot -> Field srcAnnot -> Ordering
compare :: Field srcAnnot -> Field srcAnnot -> Ordering
$c< :: forall srcAnnot.
Ord srcAnnot =>
Field srcAnnot -> Field srcAnnot -> Bool
< :: Field srcAnnot -> Field srcAnnot -> Bool
$c<= :: forall srcAnnot.
Ord srcAnnot =>
Field srcAnnot -> Field srcAnnot -> Bool
<= :: Field srcAnnot -> Field srcAnnot -> Bool
$c> :: forall srcAnnot.
Ord srcAnnot =>
Field srcAnnot -> Field srcAnnot -> Bool
> :: Field srcAnnot -> Field srcAnnot -> Bool
$c>= :: forall srcAnnot.
Ord srcAnnot =>
Field srcAnnot -> Field srcAnnot -> Bool
>= :: Field srcAnnot -> Field srcAnnot -> Bool
$cmax :: forall srcAnnot.
Ord srcAnnot =>
Field srcAnnot -> Field srcAnnot -> Field srcAnnot
max :: Field srcAnnot -> Field srcAnnot -> Field srcAnnot
$cmin :: forall srcAnnot.
Ord srcAnnot =>
Field srcAnnot -> Field srcAnnot -> Field srcAnnot
min :: Field srcAnnot -> Field srcAnnot -> Field srcAnnot
Ord, Field srcAnnot -> Field srcAnnot -> Bool
(Field srcAnnot -> Field srcAnnot -> Bool)
-> (Field srcAnnot -> Field srcAnnot -> Bool)
-> Eq (Field srcAnnot)
forall srcAnnot.
Eq srcAnnot =>
Field srcAnnot -> Field srcAnnot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall srcAnnot.
Eq srcAnnot =>
Field srcAnnot -> Field srcAnnot -> Bool
== :: Field srcAnnot -> Field srcAnnot -> Bool
$c/= :: forall srcAnnot.
Eq srcAnnot =>
Field srcAnnot -> Field srcAnnot -> Bool
/= :: Field srcAnnot -> Field srcAnnot -> Bool
Eq, Typeable (Field srcAnnot)
Typeable (Field srcAnnot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Field srcAnnot -> c (Field srcAnnot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Field srcAnnot))
-> (Field srcAnnot -> Constr)
-> (Field srcAnnot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Field srcAnnot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Field srcAnnot)))
-> ((forall b. Data b => b -> b)
    -> Field srcAnnot -> Field srcAnnot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Field srcAnnot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Field srcAnnot -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> Field srcAnnot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Field srcAnnot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> Field srcAnnot -> m (Field srcAnnot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Field srcAnnot -> m (Field srcAnnot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Field srcAnnot -> m (Field srcAnnot))
-> Data (Field srcAnnot)
Field srcAnnot -> Constr
Field srcAnnot -> DataType
(forall b. Data b => b -> b) -> Field srcAnnot -> Field srcAnnot
forall srcAnnot. Data srcAnnot => Typeable (Field srcAnnot)
forall srcAnnot. Data srcAnnot => Field srcAnnot -> Constr
forall srcAnnot. Data srcAnnot => Field srcAnnot -> DataType
forall srcAnnot.
Data srcAnnot =>
(forall b. Data b => b -> b) -> Field srcAnnot -> Field srcAnnot
forall srcAnnot u.
Data srcAnnot =>
Int -> (forall d. Data d => d -> u) -> Field srcAnnot -> u
forall srcAnnot u.
Data srcAnnot =>
(forall d. Data d => d -> u) -> Field srcAnnot -> [u]
forall srcAnnot r r'.
Data srcAnnot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Field srcAnnot -> r
forall srcAnnot r r'.
Data srcAnnot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Field srcAnnot -> r
forall srcAnnot (m :: * -> *).
(Data srcAnnot, Monad m) =>
(forall d. Data d => d -> m d)
-> Field srcAnnot -> m (Field srcAnnot)
forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Field srcAnnot -> m (Field srcAnnot)
forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Field srcAnnot)
forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Field srcAnnot -> c (Field srcAnnot)
forall srcAnnot (t :: * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Field srcAnnot))
forall srcAnnot (t :: * -> * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Field srcAnnot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> Field srcAnnot -> u
forall u. (forall d. Data d => d -> u) -> Field srcAnnot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Field srcAnnot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Field srcAnnot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Field srcAnnot -> m (Field srcAnnot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Field srcAnnot -> m (Field srcAnnot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Field srcAnnot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Field srcAnnot -> c (Field srcAnnot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Field srcAnnot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Field srcAnnot))
$cgfoldl :: forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Field srcAnnot -> c (Field srcAnnot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Field srcAnnot -> c (Field srcAnnot)
$cgunfold :: forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Field srcAnnot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Field srcAnnot)
$ctoConstr :: forall srcAnnot. Data srcAnnot => Field srcAnnot -> Constr
toConstr :: Field srcAnnot -> Constr
$cdataTypeOf :: forall srcAnnot. Data srcAnnot => Field srcAnnot -> DataType
dataTypeOf :: Field srcAnnot -> DataType
$cdataCast1 :: forall srcAnnot (t :: * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Field srcAnnot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Field srcAnnot))
$cdataCast2 :: forall srcAnnot (t :: * -> * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Field srcAnnot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Field srcAnnot))
$cgmapT :: forall srcAnnot.
Data srcAnnot =>
(forall b. Data b => b -> b) -> Field srcAnnot -> Field srcAnnot
gmapT :: (forall b. Data b => b -> b) -> Field srcAnnot -> Field srcAnnot
$cgmapQl :: forall srcAnnot r r'.
Data srcAnnot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Field srcAnnot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Field srcAnnot -> r
$cgmapQr :: forall srcAnnot r r'.
Data srcAnnot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Field srcAnnot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Field srcAnnot -> r
$cgmapQ :: forall srcAnnot u.
Data srcAnnot =>
(forall d. Data d => d -> u) -> Field srcAnnot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Field srcAnnot -> [u]
$cgmapQi :: forall srcAnnot u.
Data srcAnnot =>
Int -> (forall d. Data d => d -> u) -> Field srcAnnot -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> Field srcAnnot -> u
$cgmapM :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, Monad m) =>
(forall d. Data d => d -> m d)
-> Field srcAnnot -> m (Field srcAnnot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Field srcAnnot -> m (Field srcAnnot)
$cgmapMp :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Field srcAnnot -> m (Field srcAnnot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Field srcAnnot -> m (Field srcAnnot)
$cgmapMo :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Field srcAnnot -> m (Field srcAnnot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Field srcAnnot -> m (Field srcAnnot)
Data, Typeable, (forall x. Field srcAnnot -> Rep (Field srcAnnot) x)
-> (forall x. Rep (Field srcAnnot) x -> Field srcAnnot)
-> Generic (Field srcAnnot)
forall x. Rep (Field srcAnnot) x -> Field srcAnnot
forall x. Field srcAnnot -> Rep (Field srcAnnot) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall srcAnnot x. Rep (Field srcAnnot) x -> Field srcAnnot
forall srcAnnot x. Field srcAnnot -> Rep (Field srcAnnot) x
$cfrom :: forall srcAnnot x. Field srcAnnot -> Rep (Field srcAnnot) x
from :: forall x. Field srcAnnot -> Rep (Field srcAnnot) x
$cto :: forall srcAnnot x. Rep (Field srcAnnot) x -> Field srcAnnot
to :: forall x. Rep (Field srcAnnot) x -> Field srcAnnot
Generic, (forall a b. (a -> b) -> Field a -> Field b)
-> (forall a b. a -> Field b -> Field a) -> Functor Field
forall a b. a -> Field b -> Field a
forall a b. (a -> b) -> Field a -> Field b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Field a -> Field b
fmap :: forall a b. (a -> b) -> Field a -> Field b
$c<$ :: forall a b. a -> Field b -> Field a
<$ :: forall a b. a -> Field b -> Field a
Functor)

identifier :: Lens (Field a) (Maybe Integer)
identifier :: forall a (f :: * -> *).
Functor f =>
(Maybe Integer -> f (Maybe Integer)) -> Field a -> f (Field a)
identifier = (Field a -> Maybe Integer)
-> (Field a -> Maybe Integer -> Field a)
-> Lens (Field a) (Maybe Integer)
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Field a -> Maybe Integer
forall srcAnnot. Field srcAnnot -> Maybe Integer
fieldIdentifier (\Field a
s Maybe Integer
a -> Field a
s { fieldIdentifier = a })

requiredness :: Lens (Field a) (Maybe FieldRequiredness)
requiredness :: forall a (f :: * -> *).
Functor f =>
(Maybe FieldRequiredness -> f (Maybe FieldRequiredness))
-> Field a -> f (Field a)
requiredness = (Field a -> Maybe FieldRequiredness)
-> (Field a -> Maybe FieldRequiredness -> Field a)
-> Lens (Field a) (Maybe FieldRequiredness)
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Field a -> Maybe FieldRequiredness
forall srcAnnot. Field srcAnnot -> Maybe FieldRequiredness
fieldRequiredness (\Field a
s Maybe FieldRequiredness
a -> Field a
s { fieldRequiredness = a })

defaultValue :: Lens (Field a) (Maybe (ConstValue a))
defaultValue :: forall a (f :: * -> *).
Functor f =>
(Maybe (ConstValue a) -> f (Maybe (ConstValue a)))
-> Field a -> f (Field a)
defaultValue = (Field a -> Maybe (ConstValue a))
-> (Field a -> Maybe (ConstValue a) -> Field a)
-> Lens (Field a) (Maybe (ConstValue a))
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Field a -> Maybe (ConstValue a)
forall srcAnnot. Field srcAnnot -> Maybe (ConstValue srcAnnot)
fieldDefaultValue (\Field a
s Maybe (ConstValue a)
a -> Field a
s { fieldDefaultValue = a })

instance HasName (Field a) where
    name :: Lens (Field a) Text
name = (Field a -> Text)
-> (Field a -> Text -> Field a) -> Lens (Field a) Text
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Field a -> Text
forall srcAnnot. Field srcAnnot -> Text
fieldName (\Field a
s Text
a -> Field a
s { fieldName = a })

instance HasValueType Field where
    valueType :: forall a. Lens (Field a) (TypeReference a)
valueType = (Field a -> TypeReference a)
-> (Field a -> TypeReference a -> Field a)
-> Lens (Field a) (TypeReference a)
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Field a -> TypeReference a
forall srcAnnot. Field srcAnnot -> TypeReference srcAnnot
fieldValueType (\Field a
s TypeReference a
a -> Field a
s { fieldValueType = a })

instance HasSrcAnnot Field where
    srcAnnot :: forall a. Lens (Field a) a
srcAnnot = (Field a -> a) -> (Field a -> a -> Field a) -> Lens (Field a) a
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Field a -> a
forall srcAnnot. Field srcAnnot -> srcAnnot
fieldSrcAnnot (\Field a
s a
a -> Field a
s { fieldSrcAnnot = a })

instance HasDocstring (Field a) where
    docstring :: Lens (Field a) (Maybe Text)
docstring = (Field a -> Maybe Text)
-> (Field a -> Maybe Text -> Field a)
-> Lens (Field a) (Maybe Text)
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Field a -> Maybe Text
forall srcAnnot. Field srcAnnot -> Maybe Text
fieldDocstring (\Field a
s Maybe Text
a -> Field a
s { fieldDocstring = a })

instance HasAnnotations (Field a) where
    annotations :: Lens (Field a) [TypeAnnotation]
annotations = (Field a -> [TypeAnnotation])
-> (Field a -> [TypeAnnotation] -> Field a)
-> Lens (Field a) [TypeAnnotation]
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Field a -> [TypeAnnotation]
forall srcAnnot. Field srcAnnot -> [TypeAnnotation]
fieldAnnotations (\Field a
s [TypeAnnotation]
a -> Field a
s { fieldAnnotations = a })

class HasFields t where
    fields :: Lens (t a) [Field a]

-- | A function defined inside a service.
data Function srcAnnot = Function
    { forall srcAnnot. Function srcAnnot -> Bool
functionOneWay      :: Bool
    -- ^ Whether the function is @oneway@. If it's one way, it cannot receive
    -- repsonses.
    , forall srcAnnot.
Function srcAnnot -> Maybe (TypeReference srcAnnot)
functionReturnType  :: Maybe (TypeReference srcAnnot)
    -- ^ Return type of the function, or @Nothing@ if it's @void@ or @oneway@.
    , forall srcAnnot. Function srcAnnot -> Text
functionName        :: Text
    -- ^ Name of the function.
    , forall srcAnnot. Function srcAnnot -> [Field srcAnnot]
functionParameters  :: [Field srcAnnot]
    -- ^ Parameters accepted by the function.
    , forall srcAnnot. Function srcAnnot -> Maybe [Field srcAnnot]
functionExceptions  :: Maybe [Field srcAnnot]
    -- ^ Exceptions raised by the function, if any.
    , forall srcAnnot. Function srcAnnot -> [TypeAnnotation]
functionAnnotations :: [TypeAnnotation]
    -- ^ Annotations added to the function.
    , forall srcAnnot. Function srcAnnot -> Maybe Text
functionDocstring   :: Docstring
    -- ^ Documentation.
    , forall srcAnnot. Function srcAnnot -> srcAnnot
functionSrcAnnot    :: srcAnnot
    }
  deriving (Int -> Function srcAnnot -> ShowS
[Function srcAnnot] -> ShowS
Function srcAnnot -> String
(Int -> Function srcAnnot -> ShowS)
-> (Function srcAnnot -> String)
-> ([Function srcAnnot] -> ShowS)
-> Show (Function srcAnnot)
forall srcAnnot. Show srcAnnot => Int -> Function srcAnnot -> ShowS
forall srcAnnot. Show srcAnnot => [Function srcAnnot] -> ShowS
forall srcAnnot. Show srcAnnot => Function srcAnnot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall srcAnnot. Show srcAnnot => Int -> Function srcAnnot -> ShowS
showsPrec :: Int -> Function srcAnnot -> ShowS
$cshow :: forall srcAnnot. Show srcAnnot => Function srcAnnot -> String
show :: Function srcAnnot -> String
$cshowList :: forall srcAnnot. Show srcAnnot => [Function srcAnnot] -> ShowS
showList :: [Function srcAnnot] -> ShowS
Show, Eq (Function srcAnnot)
Eq (Function srcAnnot) =>
(Function srcAnnot -> Function srcAnnot -> Ordering)
-> (Function srcAnnot -> Function srcAnnot -> Bool)
-> (Function srcAnnot -> Function srcAnnot -> Bool)
-> (Function srcAnnot -> Function srcAnnot -> Bool)
-> (Function srcAnnot -> Function srcAnnot -> Bool)
-> (Function srcAnnot -> Function srcAnnot -> Function srcAnnot)
-> (Function srcAnnot -> Function srcAnnot -> Function srcAnnot)
-> Ord (Function srcAnnot)
Function srcAnnot -> Function srcAnnot -> Bool
Function srcAnnot -> Function srcAnnot -> Ordering
Function srcAnnot -> Function srcAnnot -> Function srcAnnot
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 srcAnnot. Ord srcAnnot => Eq (Function srcAnnot)
forall srcAnnot.
Ord srcAnnot =>
Function srcAnnot -> Function srcAnnot -> Bool
forall srcAnnot.
Ord srcAnnot =>
Function srcAnnot -> Function srcAnnot -> Ordering
forall srcAnnot.
Ord srcAnnot =>
Function srcAnnot -> Function srcAnnot -> Function srcAnnot
$ccompare :: forall srcAnnot.
Ord srcAnnot =>
Function srcAnnot -> Function srcAnnot -> Ordering
compare :: Function srcAnnot -> Function srcAnnot -> Ordering
$c< :: forall srcAnnot.
Ord srcAnnot =>
Function srcAnnot -> Function srcAnnot -> Bool
< :: Function srcAnnot -> Function srcAnnot -> Bool
$c<= :: forall srcAnnot.
Ord srcAnnot =>
Function srcAnnot -> Function srcAnnot -> Bool
<= :: Function srcAnnot -> Function srcAnnot -> Bool
$c> :: forall srcAnnot.
Ord srcAnnot =>
Function srcAnnot -> Function srcAnnot -> Bool
> :: Function srcAnnot -> Function srcAnnot -> Bool
$c>= :: forall srcAnnot.
Ord srcAnnot =>
Function srcAnnot -> Function srcAnnot -> Bool
>= :: Function srcAnnot -> Function srcAnnot -> Bool
$cmax :: forall srcAnnot.
Ord srcAnnot =>
Function srcAnnot -> Function srcAnnot -> Function srcAnnot
max :: Function srcAnnot -> Function srcAnnot -> Function srcAnnot
$cmin :: forall srcAnnot.
Ord srcAnnot =>
Function srcAnnot -> Function srcAnnot -> Function srcAnnot
min :: Function srcAnnot -> Function srcAnnot -> Function srcAnnot
Ord, Function srcAnnot -> Function srcAnnot -> Bool
(Function srcAnnot -> Function srcAnnot -> Bool)
-> (Function srcAnnot -> Function srcAnnot -> Bool)
-> Eq (Function srcAnnot)
forall srcAnnot.
Eq srcAnnot =>
Function srcAnnot -> Function srcAnnot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall srcAnnot.
Eq srcAnnot =>
Function srcAnnot -> Function srcAnnot -> Bool
== :: Function srcAnnot -> Function srcAnnot -> Bool
$c/= :: forall srcAnnot.
Eq srcAnnot =>
Function srcAnnot -> Function srcAnnot -> Bool
/= :: Function srcAnnot -> Function srcAnnot -> Bool
Eq, Typeable (Function srcAnnot)
Typeable (Function srcAnnot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> Function srcAnnot
 -> c (Function srcAnnot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Function srcAnnot))
-> (Function srcAnnot -> Constr)
-> (Function srcAnnot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Function srcAnnot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Function srcAnnot)))
-> ((forall b. Data b => b -> b)
    -> Function srcAnnot -> Function srcAnnot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Function srcAnnot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Function srcAnnot -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> Function srcAnnot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Function srcAnnot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> Function srcAnnot -> m (Function srcAnnot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Function srcAnnot -> m (Function srcAnnot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Function srcAnnot -> m (Function srcAnnot))
-> Data (Function srcAnnot)
Function srcAnnot -> Constr
Function srcAnnot -> DataType
(forall b. Data b => b -> b)
-> Function srcAnnot -> Function srcAnnot
forall srcAnnot. Data srcAnnot => Typeable (Function srcAnnot)
forall srcAnnot. Data srcAnnot => Function srcAnnot -> Constr
forall srcAnnot. Data srcAnnot => Function srcAnnot -> DataType
forall srcAnnot.
Data srcAnnot =>
(forall b. Data b => b -> b)
-> Function srcAnnot -> Function srcAnnot
forall srcAnnot u.
Data srcAnnot =>
Int -> (forall d. Data d => d -> u) -> Function srcAnnot -> u
forall srcAnnot u.
Data srcAnnot =>
(forall d. Data d => d -> u) -> Function srcAnnot -> [u]
forall srcAnnot r r'.
Data srcAnnot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Function srcAnnot -> r
forall srcAnnot r r'.
Data srcAnnot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Function srcAnnot -> r
forall srcAnnot (m :: * -> *).
(Data srcAnnot, Monad m) =>
(forall d. Data d => d -> m d)
-> Function srcAnnot -> m (Function srcAnnot)
forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Function srcAnnot -> m (Function srcAnnot)
forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Function srcAnnot)
forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Function srcAnnot
-> c (Function srcAnnot)
forall srcAnnot (t :: * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Function srcAnnot))
forall srcAnnot (t :: * -> * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Function srcAnnot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> Function srcAnnot -> u
forall u. (forall d. Data d => d -> u) -> Function srcAnnot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Function srcAnnot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Function srcAnnot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Function srcAnnot -> m (Function srcAnnot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Function srcAnnot -> m (Function srcAnnot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Function srcAnnot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Function srcAnnot
-> c (Function srcAnnot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Function srcAnnot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Function srcAnnot))
$cgfoldl :: forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Function srcAnnot
-> c (Function srcAnnot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Function srcAnnot
-> c (Function srcAnnot)
$cgunfold :: forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Function srcAnnot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Function srcAnnot)
$ctoConstr :: forall srcAnnot. Data srcAnnot => Function srcAnnot -> Constr
toConstr :: Function srcAnnot -> Constr
$cdataTypeOf :: forall srcAnnot. Data srcAnnot => Function srcAnnot -> DataType
dataTypeOf :: Function srcAnnot -> DataType
$cdataCast1 :: forall srcAnnot (t :: * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Function srcAnnot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Function srcAnnot))
$cdataCast2 :: forall srcAnnot (t :: * -> * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Function srcAnnot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Function srcAnnot))
$cgmapT :: forall srcAnnot.
Data srcAnnot =>
(forall b. Data b => b -> b)
-> Function srcAnnot -> Function srcAnnot
gmapT :: (forall b. Data b => b -> b)
-> Function srcAnnot -> Function srcAnnot
$cgmapQl :: forall srcAnnot r r'.
Data srcAnnot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Function srcAnnot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Function srcAnnot -> r
$cgmapQr :: forall srcAnnot r r'.
Data srcAnnot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Function srcAnnot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Function srcAnnot -> r
$cgmapQ :: forall srcAnnot u.
Data srcAnnot =>
(forall d. Data d => d -> u) -> Function srcAnnot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Function srcAnnot -> [u]
$cgmapQi :: forall srcAnnot u.
Data srcAnnot =>
Int -> (forall d. Data d => d -> u) -> Function srcAnnot -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> Function srcAnnot -> u
$cgmapM :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, Monad m) =>
(forall d. Data d => d -> m d)
-> Function srcAnnot -> m (Function srcAnnot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Function srcAnnot -> m (Function srcAnnot)
$cgmapMp :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Function srcAnnot -> m (Function srcAnnot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Function srcAnnot -> m (Function srcAnnot)
$cgmapMo :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Function srcAnnot -> m (Function srcAnnot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Function srcAnnot -> m (Function srcAnnot)
Data, Typeable, (forall x. Function srcAnnot -> Rep (Function srcAnnot) x)
-> (forall x. Rep (Function srcAnnot) x -> Function srcAnnot)
-> Generic (Function srcAnnot)
forall x. Rep (Function srcAnnot) x -> Function srcAnnot
forall x. Function srcAnnot -> Rep (Function srcAnnot) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall srcAnnot x. Rep (Function srcAnnot) x -> Function srcAnnot
forall srcAnnot x. Function srcAnnot -> Rep (Function srcAnnot) x
$cfrom :: forall srcAnnot x. Function srcAnnot -> Rep (Function srcAnnot) x
from :: forall x. Function srcAnnot -> Rep (Function srcAnnot) x
$cto :: forall srcAnnot x. Rep (Function srcAnnot) x -> Function srcAnnot
to :: forall x. Rep (Function srcAnnot) x -> Function srcAnnot
Generic, (forall a b. (a -> b) -> Function a -> Function b)
-> (forall a b. a -> Function b -> Function a) -> Functor Function
forall a b. a -> Function b -> Function a
forall a b. (a -> b) -> Function a -> Function b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Function a -> Function b
fmap :: forall a b. (a -> b) -> Function a -> Function b
$c<$ :: forall a b. a -> Function b -> Function a
<$ :: forall a b. a -> Function b -> Function a
Functor)

oneWay :: Lens (Function a) Bool
oneWay :: forall a (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> Function a -> f (Function a)
oneWay = (Function a -> Bool)
-> (Function a -> Bool -> Function a) -> Lens (Function a) Bool
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Function a -> Bool
forall srcAnnot. Function srcAnnot -> Bool
functionOneWay (\Function a
s Bool
a -> Function a
s { functionOneWay = a })

returnType :: Lens (Function a) (Maybe (TypeReference a))
returnType :: forall a (f :: * -> *).
Functor f =>
(Maybe (TypeReference a) -> f (Maybe (TypeReference a)))
-> Function a -> f (Function a)
returnType = (Function a -> Maybe (TypeReference a))
-> (Function a -> Maybe (TypeReference a) -> Function a)
-> Lens (Function a) (Maybe (TypeReference a))
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Function a -> Maybe (TypeReference a)
forall srcAnnot.
Function srcAnnot -> Maybe (TypeReference srcAnnot)
functionReturnType (\Function a
s Maybe (TypeReference a)
a -> Function a
s { functionReturnType = a })

parameters :: Lens (Function a) [Field a]
parameters :: forall a (f :: * -> *).
Functor f =>
([Field a] -> f [Field a]) -> Function a -> f (Function a)
parameters = (Function a -> [Field a])
-> (Function a -> [Field a] -> Function a)
-> Lens (Function a) [Field a]
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Function a -> [Field a]
forall srcAnnot. Function srcAnnot -> [Field srcAnnot]
functionParameters (\Function a
s [Field a]
a -> Function a
s { functionParameters = a })

exceptions :: Lens (Function a) (Maybe [Field a])
exceptions :: forall a (f :: * -> *).
Functor f =>
(Maybe [Field a] -> f (Maybe [Field a]))
-> Function a -> f (Function a)
exceptions = (Function a -> Maybe [Field a])
-> (Function a -> Maybe [Field a] -> Function a)
-> Lens (Function a) (Maybe [Field a])
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Function a -> Maybe [Field a]
forall srcAnnot. Function srcAnnot -> Maybe [Field srcAnnot]
functionExceptions (\Function a
s Maybe [Field a]
a -> Function a
s { functionExceptions = a })

instance HasName (Function a) where
    name :: Lens (Function a) Text
name = (Function a -> Text)
-> (Function a -> Text -> Function a) -> Lens (Function a) Text
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Function a -> Text
forall srcAnnot. Function srcAnnot -> Text
functionName (\Function a
s Text
a -> Function a
s { functionName = a })

instance HasSrcAnnot Function where
    srcAnnot :: forall a. Lens (Function a) a
srcAnnot = (Function a -> a)
-> (Function a -> a -> Function a) -> Lens (Function a) a
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Function a -> a
forall srcAnnot. Function srcAnnot -> srcAnnot
functionSrcAnnot (\Function a
s a
a -> Function a
s { functionSrcAnnot = a })

instance HasDocstring (Function a) where
    docstring :: Lens (Function a) (Maybe Text)
docstring = (Function a -> Maybe Text)
-> (Function a -> Maybe Text -> Function a)
-> Lens (Function a) (Maybe Text)
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Function a -> Maybe Text
forall srcAnnot. Function srcAnnot -> Maybe Text
functionDocstring (\Function a
s Maybe Text
a -> Function a
s { functionDocstring = a })

instance HasAnnotations (Function a) where
    annotations :: Lens (Function a) [TypeAnnotation]
annotations = (Function a -> [TypeAnnotation])
-> (Function a -> [TypeAnnotation] -> Function a)
-> Lens (Function a) [TypeAnnotation]
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Function a -> [TypeAnnotation]
forall srcAnnot. Function srcAnnot -> [TypeAnnotation]
functionAnnotations (\Function a
s [TypeAnnotation]
a -> Function a
s { functionAnnotations = a })

-- | A service definition.
--
-- > service MyService {
-- >     // ...
-- > }
data Service srcAnnot = Service
    { forall srcAnnot. Service srcAnnot -> Text
serviceName        :: Text
    -- ^ Name of the service.
    , forall srcAnnot. Service srcAnnot -> Maybe Text
serviceExtends     :: Maybe Text
    -- ^ Name of the service this service extends.
    , forall srcAnnot. Service srcAnnot -> [Function srcAnnot]
serviceFunctions   :: [Function srcAnnot]
    -- ^ All the functions defined for the service.
    , forall srcAnnot. Service srcAnnot -> [TypeAnnotation]
serviceAnnotations :: [TypeAnnotation]
    -- ^ Annotations added to the service.
    , forall srcAnnot. Service srcAnnot -> Maybe Text
serviceDocstring   :: Docstring
    -- ^ Documentation.
    , forall srcAnnot. Service srcAnnot -> srcAnnot
serviceSrcAnnot    :: srcAnnot
    }
  deriving (Int -> Service srcAnnot -> ShowS
[Service srcAnnot] -> ShowS
Service srcAnnot -> String
(Int -> Service srcAnnot -> ShowS)
-> (Service srcAnnot -> String)
-> ([Service srcAnnot] -> ShowS)
-> Show (Service srcAnnot)
forall srcAnnot. Show srcAnnot => Int -> Service srcAnnot -> ShowS
forall srcAnnot. Show srcAnnot => [Service srcAnnot] -> ShowS
forall srcAnnot. Show srcAnnot => Service srcAnnot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall srcAnnot. Show srcAnnot => Int -> Service srcAnnot -> ShowS
showsPrec :: Int -> Service srcAnnot -> ShowS
$cshow :: forall srcAnnot. Show srcAnnot => Service srcAnnot -> String
show :: Service srcAnnot -> String
$cshowList :: forall srcAnnot. Show srcAnnot => [Service srcAnnot] -> ShowS
showList :: [Service srcAnnot] -> ShowS
Show, Eq (Service srcAnnot)
Eq (Service srcAnnot) =>
(Service srcAnnot -> Service srcAnnot -> Ordering)
-> (Service srcAnnot -> Service srcAnnot -> Bool)
-> (Service srcAnnot -> Service srcAnnot -> Bool)
-> (Service srcAnnot -> Service srcAnnot -> Bool)
-> (Service srcAnnot -> Service srcAnnot -> Bool)
-> (Service srcAnnot -> Service srcAnnot -> Service srcAnnot)
-> (Service srcAnnot -> Service srcAnnot -> Service srcAnnot)
-> Ord (Service srcAnnot)
Service srcAnnot -> Service srcAnnot -> Bool
Service srcAnnot -> Service srcAnnot -> Ordering
Service srcAnnot -> Service srcAnnot -> Service srcAnnot
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 srcAnnot. Ord srcAnnot => Eq (Service srcAnnot)
forall srcAnnot.
Ord srcAnnot =>
Service srcAnnot -> Service srcAnnot -> Bool
forall srcAnnot.
Ord srcAnnot =>
Service srcAnnot -> Service srcAnnot -> Ordering
forall srcAnnot.
Ord srcAnnot =>
Service srcAnnot -> Service srcAnnot -> Service srcAnnot
$ccompare :: forall srcAnnot.
Ord srcAnnot =>
Service srcAnnot -> Service srcAnnot -> Ordering
compare :: Service srcAnnot -> Service srcAnnot -> Ordering
$c< :: forall srcAnnot.
Ord srcAnnot =>
Service srcAnnot -> Service srcAnnot -> Bool
< :: Service srcAnnot -> Service srcAnnot -> Bool
$c<= :: forall srcAnnot.
Ord srcAnnot =>
Service srcAnnot -> Service srcAnnot -> Bool
<= :: Service srcAnnot -> Service srcAnnot -> Bool
$c> :: forall srcAnnot.
Ord srcAnnot =>
Service srcAnnot -> Service srcAnnot -> Bool
> :: Service srcAnnot -> Service srcAnnot -> Bool
$c>= :: forall srcAnnot.
Ord srcAnnot =>
Service srcAnnot -> Service srcAnnot -> Bool
>= :: Service srcAnnot -> Service srcAnnot -> Bool
$cmax :: forall srcAnnot.
Ord srcAnnot =>
Service srcAnnot -> Service srcAnnot -> Service srcAnnot
max :: Service srcAnnot -> Service srcAnnot -> Service srcAnnot
$cmin :: forall srcAnnot.
Ord srcAnnot =>
Service srcAnnot -> Service srcAnnot -> Service srcAnnot
min :: Service srcAnnot -> Service srcAnnot -> Service srcAnnot
Ord, Service srcAnnot -> Service srcAnnot -> Bool
(Service srcAnnot -> Service srcAnnot -> Bool)
-> (Service srcAnnot -> Service srcAnnot -> Bool)
-> Eq (Service srcAnnot)
forall srcAnnot.
Eq srcAnnot =>
Service srcAnnot -> Service srcAnnot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall srcAnnot.
Eq srcAnnot =>
Service srcAnnot -> Service srcAnnot -> Bool
== :: Service srcAnnot -> Service srcAnnot -> Bool
$c/= :: forall srcAnnot.
Eq srcAnnot =>
Service srcAnnot -> Service srcAnnot -> Bool
/= :: Service srcAnnot -> Service srcAnnot -> Bool
Eq, Typeable (Service srcAnnot)
Typeable (Service srcAnnot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> Service srcAnnot
 -> c (Service srcAnnot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Service srcAnnot))
-> (Service srcAnnot -> Constr)
-> (Service srcAnnot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Service srcAnnot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Service srcAnnot)))
-> ((forall b. Data b => b -> b)
    -> Service srcAnnot -> Service srcAnnot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Service srcAnnot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Service srcAnnot -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> Service srcAnnot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Service srcAnnot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> Service srcAnnot -> m (Service srcAnnot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Service srcAnnot -> m (Service srcAnnot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Service srcAnnot -> m (Service srcAnnot))
-> Data (Service srcAnnot)
Service srcAnnot -> Constr
Service srcAnnot -> DataType
(forall b. Data b => b -> b)
-> Service srcAnnot -> Service srcAnnot
forall srcAnnot. Data srcAnnot => Typeable (Service srcAnnot)
forall srcAnnot. Data srcAnnot => Service srcAnnot -> Constr
forall srcAnnot. Data srcAnnot => Service srcAnnot -> DataType
forall srcAnnot.
Data srcAnnot =>
(forall b. Data b => b -> b)
-> Service srcAnnot -> Service srcAnnot
forall srcAnnot u.
Data srcAnnot =>
Int -> (forall d. Data d => d -> u) -> Service srcAnnot -> u
forall srcAnnot u.
Data srcAnnot =>
(forall d. Data d => d -> u) -> Service srcAnnot -> [u]
forall srcAnnot r r'.
Data srcAnnot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Service srcAnnot -> r
forall srcAnnot r r'.
Data srcAnnot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Service srcAnnot -> r
forall srcAnnot (m :: * -> *).
(Data srcAnnot, Monad m) =>
(forall d. Data d => d -> m d)
-> Service srcAnnot -> m (Service srcAnnot)
forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Service srcAnnot -> m (Service srcAnnot)
forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Service srcAnnot)
forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Service srcAnnot -> c (Service srcAnnot)
forall srcAnnot (t :: * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Service srcAnnot))
forall srcAnnot (t :: * -> * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Service srcAnnot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> Service srcAnnot -> u
forall u. (forall d. Data d => d -> u) -> Service srcAnnot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Service srcAnnot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Service srcAnnot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Service srcAnnot -> m (Service srcAnnot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Service srcAnnot -> m (Service srcAnnot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Service srcAnnot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Service srcAnnot -> c (Service srcAnnot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Service srcAnnot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Service srcAnnot))
$cgfoldl :: forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Service srcAnnot -> c (Service srcAnnot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Service srcAnnot -> c (Service srcAnnot)
$cgunfold :: forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Service srcAnnot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Service srcAnnot)
$ctoConstr :: forall srcAnnot. Data srcAnnot => Service srcAnnot -> Constr
toConstr :: Service srcAnnot -> Constr
$cdataTypeOf :: forall srcAnnot. Data srcAnnot => Service srcAnnot -> DataType
dataTypeOf :: Service srcAnnot -> DataType
$cdataCast1 :: forall srcAnnot (t :: * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Service srcAnnot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Service srcAnnot))
$cdataCast2 :: forall srcAnnot (t :: * -> * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Service srcAnnot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Service srcAnnot))
$cgmapT :: forall srcAnnot.
Data srcAnnot =>
(forall b. Data b => b -> b)
-> Service srcAnnot -> Service srcAnnot
gmapT :: (forall b. Data b => b -> b)
-> Service srcAnnot -> Service srcAnnot
$cgmapQl :: forall srcAnnot r r'.
Data srcAnnot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Service srcAnnot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Service srcAnnot -> r
$cgmapQr :: forall srcAnnot r r'.
Data srcAnnot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Service srcAnnot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Service srcAnnot -> r
$cgmapQ :: forall srcAnnot u.
Data srcAnnot =>
(forall d. Data d => d -> u) -> Service srcAnnot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Service srcAnnot -> [u]
$cgmapQi :: forall srcAnnot u.
Data srcAnnot =>
Int -> (forall d. Data d => d -> u) -> Service srcAnnot -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> Service srcAnnot -> u
$cgmapM :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, Monad m) =>
(forall d. Data d => d -> m d)
-> Service srcAnnot -> m (Service srcAnnot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Service srcAnnot -> m (Service srcAnnot)
$cgmapMp :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Service srcAnnot -> m (Service srcAnnot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Service srcAnnot -> m (Service srcAnnot)
$cgmapMo :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Service srcAnnot -> m (Service srcAnnot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Service srcAnnot -> m (Service srcAnnot)
Data, Typeable, (forall x. Service srcAnnot -> Rep (Service srcAnnot) x)
-> (forall x. Rep (Service srcAnnot) x -> Service srcAnnot)
-> Generic (Service srcAnnot)
forall x. Rep (Service srcAnnot) x -> Service srcAnnot
forall x. Service srcAnnot -> Rep (Service srcAnnot) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall srcAnnot x. Rep (Service srcAnnot) x -> Service srcAnnot
forall srcAnnot x. Service srcAnnot -> Rep (Service srcAnnot) x
$cfrom :: forall srcAnnot x. Service srcAnnot -> Rep (Service srcAnnot) x
from :: forall x. Service srcAnnot -> Rep (Service srcAnnot) x
$cto :: forall srcAnnot x. Rep (Service srcAnnot) x -> Service srcAnnot
to :: forall x. Rep (Service srcAnnot) x -> Service srcAnnot
Generic, (forall a b. (a -> b) -> Service a -> Service b)
-> (forall a b. a -> Service b -> Service a) -> Functor Service
forall a b. a -> Service b -> Service a
forall a b. (a -> b) -> Service a -> Service b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Service a -> Service b
fmap :: forall a b. (a -> b) -> Service a -> Service b
$c<$ :: forall a b. a -> Service b -> Service a
<$ :: forall a b. a -> Service b -> Service a
Functor)

functions :: Lens (Service a) [Function a]
functions :: forall a (f :: * -> *).
Functor f =>
([Function a] -> f [Function a]) -> Service a -> f (Service a)
functions = (Service a -> [Function a])
-> (Service a -> [Function a] -> Service a)
-> Lens (Service a) [Function a]
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Service a -> [Function a]
forall srcAnnot. Service srcAnnot -> [Function srcAnnot]
serviceFunctions (\Service a
s [Function a]
a -> Service a
s { serviceFunctions = a })

extends :: Lens (Service a) (Maybe Text)
extends :: forall a (f :: * -> *).
Functor f =>
(Maybe Text -> f (Maybe Text)) -> Service a -> f (Service a)
extends = (Service a -> Maybe Text)
-> (Service a -> Maybe Text -> Service a)
-> Lens (Service a) (Maybe Text)
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Service a -> Maybe Text
forall srcAnnot. Service srcAnnot -> Maybe Text
serviceExtends (\Service a
s Maybe Text
a -> Service a
s { serviceExtends = a })

instance HasName (Service a) where
    name :: Lens (Service a) Text
name = (Service a -> Text)
-> (Service a -> Text -> Service a) -> Lens (Service a) Text
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Service a -> Text
forall srcAnnot. Service srcAnnot -> Text
serviceName (\Service a
s Text
a -> Service a
s { serviceName = a })

instance HasSrcAnnot Service where
    srcAnnot :: forall a. Lens (Service a) a
srcAnnot = (Service a -> a)
-> (Service a -> a -> Service a) -> Lens (Service a) a
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Service a -> a
forall srcAnnot. Service srcAnnot -> srcAnnot
serviceSrcAnnot (\Service a
s a
a -> Service a
s { serviceSrcAnnot = a })

instance HasDocstring (Service a) where
    docstring :: Lens (Service a) (Maybe Text)
docstring = (Service a -> Maybe Text)
-> (Service a -> Maybe Text -> Service a)
-> Lens (Service a) (Maybe Text)
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Service a -> Maybe Text
forall srcAnnot. Service srcAnnot -> Maybe Text
serviceDocstring (\Service a
s Maybe Text
a -> Service a
s { serviceDocstring = a })

instance HasAnnotations (Service a) where
    annotations :: Lens (Service a) [TypeAnnotation]
annotations = (Service a -> [TypeAnnotation])
-> (Service a -> [TypeAnnotation] -> Service a)
-> Lens (Service a) [TypeAnnotation]
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Service a -> [TypeAnnotation]
forall srcAnnot. Service srcAnnot -> [TypeAnnotation]
serviceAnnotations (\Service a
s [TypeAnnotation]
a -> Service a
s { serviceAnnotations = a })

-- | A declared constant.
--
-- > const i32 code = 1;
data Const srcAnnot = Const
    { forall srcAnnot. Const srcAnnot -> TypeReference srcAnnot
constValueType :: TypeReference srcAnnot
    -- ^ Type of the constant.
    , forall srcAnnot. Const srcAnnot -> Text
constName      :: Text
    -- ^ Name of the constant.
    , forall srcAnnot. Const srcAnnot -> ConstValue srcAnnot
constValue     :: ConstValue srcAnnot
    -- ^ Value of the constant.
    , forall srcAnnot. Const srcAnnot -> Maybe Text
constDocstring :: Docstring
    -- ^ Documentation.
    , forall srcAnnot. Const srcAnnot -> srcAnnot
constSrcAnnot  :: srcAnnot
    }
  deriving (Int -> Const srcAnnot -> ShowS
[Const srcAnnot] -> ShowS
Const srcAnnot -> String
(Int -> Const srcAnnot -> ShowS)
-> (Const srcAnnot -> String)
-> ([Const srcAnnot] -> ShowS)
-> Show (Const srcAnnot)
forall srcAnnot. Show srcAnnot => Int -> Const srcAnnot -> ShowS
forall srcAnnot. Show srcAnnot => [Const srcAnnot] -> ShowS
forall srcAnnot. Show srcAnnot => Const srcAnnot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall srcAnnot. Show srcAnnot => Int -> Const srcAnnot -> ShowS
showsPrec :: Int -> Const srcAnnot -> ShowS
$cshow :: forall srcAnnot. Show srcAnnot => Const srcAnnot -> String
show :: Const srcAnnot -> String
$cshowList :: forall srcAnnot. Show srcAnnot => [Const srcAnnot] -> ShowS
showList :: [Const srcAnnot] -> ShowS
Show, Eq (Const srcAnnot)
Eq (Const srcAnnot) =>
(Const srcAnnot -> Const srcAnnot -> Ordering)
-> (Const srcAnnot -> Const srcAnnot -> Bool)
-> (Const srcAnnot -> Const srcAnnot -> Bool)
-> (Const srcAnnot -> Const srcAnnot -> Bool)
-> (Const srcAnnot -> Const srcAnnot -> Bool)
-> (Const srcAnnot -> Const srcAnnot -> Const srcAnnot)
-> (Const srcAnnot -> Const srcAnnot -> Const srcAnnot)
-> Ord (Const srcAnnot)
Const srcAnnot -> Const srcAnnot -> Bool
Const srcAnnot -> Const srcAnnot -> Ordering
Const srcAnnot -> Const srcAnnot -> Const srcAnnot
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 srcAnnot. Ord srcAnnot => Eq (Const srcAnnot)
forall srcAnnot.
Ord srcAnnot =>
Const srcAnnot -> Const srcAnnot -> Bool
forall srcAnnot.
Ord srcAnnot =>
Const srcAnnot -> Const srcAnnot -> Ordering
forall srcAnnot.
Ord srcAnnot =>
Const srcAnnot -> Const srcAnnot -> Const srcAnnot
$ccompare :: forall srcAnnot.
Ord srcAnnot =>
Const srcAnnot -> Const srcAnnot -> Ordering
compare :: Const srcAnnot -> Const srcAnnot -> Ordering
$c< :: forall srcAnnot.
Ord srcAnnot =>
Const srcAnnot -> Const srcAnnot -> Bool
< :: Const srcAnnot -> Const srcAnnot -> Bool
$c<= :: forall srcAnnot.
Ord srcAnnot =>
Const srcAnnot -> Const srcAnnot -> Bool
<= :: Const srcAnnot -> Const srcAnnot -> Bool
$c> :: forall srcAnnot.
Ord srcAnnot =>
Const srcAnnot -> Const srcAnnot -> Bool
> :: Const srcAnnot -> Const srcAnnot -> Bool
$c>= :: forall srcAnnot.
Ord srcAnnot =>
Const srcAnnot -> Const srcAnnot -> Bool
>= :: Const srcAnnot -> Const srcAnnot -> Bool
$cmax :: forall srcAnnot.
Ord srcAnnot =>
Const srcAnnot -> Const srcAnnot -> Const srcAnnot
max :: Const srcAnnot -> Const srcAnnot -> Const srcAnnot
$cmin :: forall srcAnnot.
Ord srcAnnot =>
Const srcAnnot -> Const srcAnnot -> Const srcAnnot
min :: Const srcAnnot -> Const srcAnnot -> Const srcAnnot
Ord, Const srcAnnot -> Const srcAnnot -> Bool
(Const srcAnnot -> Const srcAnnot -> Bool)
-> (Const srcAnnot -> Const srcAnnot -> Bool)
-> Eq (Const srcAnnot)
forall srcAnnot.
Eq srcAnnot =>
Const srcAnnot -> Const srcAnnot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall srcAnnot.
Eq srcAnnot =>
Const srcAnnot -> Const srcAnnot -> Bool
== :: Const srcAnnot -> Const srcAnnot -> Bool
$c/= :: forall srcAnnot.
Eq srcAnnot =>
Const srcAnnot -> Const srcAnnot -> Bool
/= :: Const srcAnnot -> Const srcAnnot -> Bool
Eq, Typeable (Const srcAnnot)
Typeable (Const srcAnnot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Const srcAnnot -> c (Const srcAnnot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Const srcAnnot))
-> (Const srcAnnot -> Constr)
-> (Const srcAnnot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Const srcAnnot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Const srcAnnot)))
-> ((forall b. Data b => b -> b)
    -> Const srcAnnot -> Const srcAnnot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Const srcAnnot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Const srcAnnot -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> Const srcAnnot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Const srcAnnot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> Const srcAnnot -> m (Const srcAnnot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Const srcAnnot -> m (Const srcAnnot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Const srcAnnot -> m (Const srcAnnot))
-> Data (Const srcAnnot)
Const srcAnnot -> Constr
Const srcAnnot -> DataType
(forall b. Data b => b -> b) -> Const srcAnnot -> Const srcAnnot
forall srcAnnot. Data srcAnnot => Typeable (Const srcAnnot)
forall srcAnnot. Data srcAnnot => Const srcAnnot -> Constr
forall srcAnnot. Data srcAnnot => Const srcAnnot -> DataType
forall srcAnnot.
Data srcAnnot =>
(forall b. Data b => b -> b) -> Const srcAnnot -> Const srcAnnot
forall srcAnnot u.
Data srcAnnot =>
Int -> (forall d. Data d => d -> u) -> Const srcAnnot -> u
forall srcAnnot u.
Data srcAnnot =>
(forall d. Data d => d -> u) -> Const srcAnnot -> [u]
forall srcAnnot r r'.
Data srcAnnot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Const srcAnnot -> r
forall srcAnnot r r'.
Data srcAnnot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Const srcAnnot -> r
forall srcAnnot (m :: * -> *).
(Data srcAnnot, Monad m) =>
(forall d. Data d => d -> m d)
-> Const srcAnnot -> m (Const srcAnnot)
forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Const srcAnnot -> m (Const srcAnnot)
forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Const srcAnnot)
forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Const srcAnnot -> c (Const srcAnnot)
forall srcAnnot (t :: * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Const srcAnnot))
forall srcAnnot (t :: * -> * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Const srcAnnot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> Const srcAnnot -> u
forall u. (forall d. Data d => d -> u) -> Const srcAnnot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Const srcAnnot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Const srcAnnot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Const srcAnnot -> m (Const srcAnnot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Const srcAnnot -> m (Const srcAnnot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Const srcAnnot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Const srcAnnot -> c (Const srcAnnot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Const srcAnnot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Const srcAnnot))
$cgfoldl :: forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Const srcAnnot -> c (Const srcAnnot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Const srcAnnot -> c (Const srcAnnot)
$cgunfold :: forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Const srcAnnot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Const srcAnnot)
$ctoConstr :: forall srcAnnot. Data srcAnnot => Const srcAnnot -> Constr
toConstr :: Const srcAnnot -> Constr
$cdataTypeOf :: forall srcAnnot. Data srcAnnot => Const srcAnnot -> DataType
dataTypeOf :: Const srcAnnot -> DataType
$cdataCast1 :: forall srcAnnot (t :: * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Const srcAnnot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Const srcAnnot))
$cdataCast2 :: forall srcAnnot (t :: * -> * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Const srcAnnot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Const srcAnnot))
$cgmapT :: forall srcAnnot.
Data srcAnnot =>
(forall b. Data b => b -> b) -> Const srcAnnot -> Const srcAnnot
gmapT :: (forall b. Data b => b -> b) -> Const srcAnnot -> Const srcAnnot
$cgmapQl :: forall srcAnnot r r'.
Data srcAnnot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Const srcAnnot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Const srcAnnot -> r
$cgmapQr :: forall srcAnnot r r'.
Data srcAnnot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Const srcAnnot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Const srcAnnot -> r
$cgmapQ :: forall srcAnnot u.
Data srcAnnot =>
(forall d. Data d => d -> u) -> Const srcAnnot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Const srcAnnot -> [u]
$cgmapQi :: forall srcAnnot u.
Data srcAnnot =>
Int -> (forall d. Data d => d -> u) -> Const srcAnnot -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> Const srcAnnot -> u
$cgmapM :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, Monad m) =>
(forall d. Data d => d -> m d)
-> Const srcAnnot -> m (Const srcAnnot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Const srcAnnot -> m (Const srcAnnot)
$cgmapMp :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Const srcAnnot -> m (Const srcAnnot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Const srcAnnot -> m (Const srcAnnot)
$cgmapMo :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Const srcAnnot -> m (Const srcAnnot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Const srcAnnot -> m (Const srcAnnot)
Data, Typeable, (forall x. Const srcAnnot -> Rep (Const srcAnnot) x)
-> (forall x. Rep (Const srcAnnot) x -> Const srcAnnot)
-> Generic (Const srcAnnot)
forall x. Rep (Const srcAnnot) x -> Const srcAnnot
forall x. Const srcAnnot -> Rep (Const srcAnnot) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall srcAnnot x. Rep (Const srcAnnot) x -> Const srcAnnot
forall srcAnnot x. Const srcAnnot -> Rep (Const srcAnnot) x
$cfrom :: forall srcAnnot x. Const srcAnnot -> Rep (Const srcAnnot) x
from :: forall x. Const srcAnnot -> Rep (Const srcAnnot) x
$cto :: forall srcAnnot x. Rep (Const srcAnnot) x -> Const srcAnnot
to :: forall x. Rep (Const srcAnnot) x -> Const srcAnnot
Generic, (forall a b. (a -> b) -> Const a -> Const b)
-> (forall a b. a -> Const b -> Const a) -> Functor Const
forall a b. a -> Const b -> Const a
forall a b. (a -> b) -> Const a -> Const b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Const a -> Const b
fmap :: forall a b. (a -> b) -> Const a -> Const b
$c<$ :: forall a b. a -> Const b -> Const a
<$ :: forall a b. a -> Const b -> Const a
Functor)

instance HasValue (Const a) (ConstValue a) where
    value :: Lens (Const a) (ConstValue a)
value = (Const a -> ConstValue a)
-> (Const a -> ConstValue a -> Const a)
-> Lens (Const a) (ConstValue a)
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Const a -> ConstValue a
forall srcAnnot. Const srcAnnot -> ConstValue srcAnnot
constValue (\Const a
s ConstValue a
a -> Const a
s { constValue = a })

instance HasName (Const a) where
    name :: Lens (Const a) Text
name = (Const a -> Text)
-> (Const a -> Text -> Const a) -> Lens (Const a) Text
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Const a -> Text
forall srcAnnot. Const srcAnnot -> Text
constName (\Const a
s Text
a -> Const a
s { constName = a })

instance HasSrcAnnot Const where
    srcAnnot :: forall a. Lens (Const a) a
srcAnnot = (Const a -> a) -> (Const a -> a -> Const a) -> Lens (Const a) a
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Const a -> a
forall srcAnnot. Const srcAnnot -> srcAnnot
constSrcAnnot (\Const a
s a
a -> Const a
s { constSrcAnnot = a })

instance HasValueType Const where
    valueType :: forall a. Lens (Const a) (TypeReference a)
valueType = (Const a -> TypeReference a)
-> (Const a -> TypeReference a -> Const a)
-> Lens (Const a) (TypeReference a)
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Const a -> TypeReference a
forall srcAnnot. Const srcAnnot -> TypeReference srcAnnot
constValueType (\Const a
s TypeReference a
a -> Const a
s { constValueType = a })

instance HasDocstring (Const a) where
    docstring :: Lens (Const a) (Maybe Text)
docstring = (Const a -> Maybe Text)
-> (Const a -> Maybe Text -> Const a)
-> Lens (Const a) (Maybe Text)
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Const a -> Maybe Text
forall srcAnnot. Const srcAnnot -> Maybe Text
constDocstring (\Const a
s Maybe Text
a -> Const a
s { constDocstring = a })

-- | A typedef is just an alias for another type.
--
-- > typedef common.Foo Bar
data Typedef srcAnnot = Typedef
    { forall srcAnnot. Typedef srcAnnot -> TypeReference srcAnnot
typedefTargetType  :: TypeReference srcAnnot
    -- ^ The aliased type.
    , forall srcAnnot. Typedef srcAnnot -> Text
typedefName        :: Text
    -- ^ Name of the new type.
    , forall srcAnnot. Typedef srcAnnot -> [TypeAnnotation]
typedefAnnotations :: [TypeAnnotation]
    -- ^ Annotations added to the typedef.
    , forall srcAnnot. Typedef srcAnnot -> Maybe Text
typedefDocstring   :: Docstring
    -- ^ Documentation.
    , forall srcAnnot. Typedef srcAnnot -> srcAnnot
typedefSrcAnnot    :: srcAnnot
    }
  deriving (Int -> Typedef srcAnnot -> ShowS
[Typedef srcAnnot] -> ShowS
Typedef srcAnnot -> String
(Int -> Typedef srcAnnot -> ShowS)
-> (Typedef srcAnnot -> String)
-> ([Typedef srcAnnot] -> ShowS)
-> Show (Typedef srcAnnot)
forall srcAnnot. Show srcAnnot => Int -> Typedef srcAnnot -> ShowS
forall srcAnnot. Show srcAnnot => [Typedef srcAnnot] -> ShowS
forall srcAnnot. Show srcAnnot => Typedef srcAnnot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall srcAnnot. Show srcAnnot => Int -> Typedef srcAnnot -> ShowS
showsPrec :: Int -> Typedef srcAnnot -> ShowS
$cshow :: forall srcAnnot. Show srcAnnot => Typedef srcAnnot -> String
show :: Typedef srcAnnot -> String
$cshowList :: forall srcAnnot. Show srcAnnot => [Typedef srcAnnot] -> ShowS
showList :: [Typedef srcAnnot] -> ShowS
Show, Eq (Typedef srcAnnot)
Eq (Typedef srcAnnot) =>
(Typedef srcAnnot -> Typedef srcAnnot -> Ordering)
-> (Typedef srcAnnot -> Typedef srcAnnot -> Bool)
-> (Typedef srcAnnot -> Typedef srcAnnot -> Bool)
-> (Typedef srcAnnot -> Typedef srcAnnot -> Bool)
-> (Typedef srcAnnot -> Typedef srcAnnot -> Bool)
-> (Typedef srcAnnot -> Typedef srcAnnot -> Typedef srcAnnot)
-> (Typedef srcAnnot -> Typedef srcAnnot -> Typedef srcAnnot)
-> Ord (Typedef srcAnnot)
Typedef srcAnnot -> Typedef srcAnnot -> Bool
Typedef srcAnnot -> Typedef srcAnnot -> Ordering
Typedef srcAnnot -> Typedef srcAnnot -> Typedef srcAnnot
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 srcAnnot. Ord srcAnnot => Eq (Typedef srcAnnot)
forall srcAnnot.
Ord srcAnnot =>
Typedef srcAnnot -> Typedef srcAnnot -> Bool
forall srcAnnot.
Ord srcAnnot =>
Typedef srcAnnot -> Typedef srcAnnot -> Ordering
forall srcAnnot.
Ord srcAnnot =>
Typedef srcAnnot -> Typedef srcAnnot -> Typedef srcAnnot
$ccompare :: forall srcAnnot.
Ord srcAnnot =>
Typedef srcAnnot -> Typedef srcAnnot -> Ordering
compare :: Typedef srcAnnot -> Typedef srcAnnot -> Ordering
$c< :: forall srcAnnot.
Ord srcAnnot =>
Typedef srcAnnot -> Typedef srcAnnot -> Bool
< :: Typedef srcAnnot -> Typedef srcAnnot -> Bool
$c<= :: forall srcAnnot.
Ord srcAnnot =>
Typedef srcAnnot -> Typedef srcAnnot -> Bool
<= :: Typedef srcAnnot -> Typedef srcAnnot -> Bool
$c> :: forall srcAnnot.
Ord srcAnnot =>
Typedef srcAnnot -> Typedef srcAnnot -> Bool
> :: Typedef srcAnnot -> Typedef srcAnnot -> Bool
$c>= :: forall srcAnnot.
Ord srcAnnot =>
Typedef srcAnnot -> Typedef srcAnnot -> Bool
>= :: Typedef srcAnnot -> Typedef srcAnnot -> Bool
$cmax :: forall srcAnnot.
Ord srcAnnot =>
Typedef srcAnnot -> Typedef srcAnnot -> Typedef srcAnnot
max :: Typedef srcAnnot -> Typedef srcAnnot -> Typedef srcAnnot
$cmin :: forall srcAnnot.
Ord srcAnnot =>
Typedef srcAnnot -> Typedef srcAnnot -> Typedef srcAnnot
min :: Typedef srcAnnot -> Typedef srcAnnot -> Typedef srcAnnot
Ord, Typedef srcAnnot -> Typedef srcAnnot -> Bool
(Typedef srcAnnot -> Typedef srcAnnot -> Bool)
-> (Typedef srcAnnot -> Typedef srcAnnot -> Bool)
-> Eq (Typedef srcAnnot)
forall srcAnnot.
Eq srcAnnot =>
Typedef srcAnnot -> Typedef srcAnnot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall srcAnnot.
Eq srcAnnot =>
Typedef srcAnnot -> Typedef srcAnnot -> Bool
== :: Typedef srcAnnot -> Typedef srcAnnot -> Bool
$c/= :: forall srcAnnot.
Eq srcAnnot =>
Typedef srcAnnot -> Typedef srcAnnot -> Bool
/= :: Typedef srcAnnot -> Typedef srcAnnot -> Bool
Eq, Typeable (Typedef srcAnnot)
Typeable (Typedef srcAnnot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> Typedef srcAnnot
 -> c (Typedef srcAnnot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Typedef srcAnnot))
-> (Typedef srcAnnot -> Constr)
-> (Typedef srcAnnot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Typedef srcAnnot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Typedef srcAnnot)))
-> ((forall b. Data b => b -> b)
    -> Typedef srcAnnot -> Typedef srcAnnot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Typedef srcAnnot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Typedef srcAnnot -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> Typedef srcAnnot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Typedef srcAnnot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> Typedef srcAnnot -> m (Typedef srcAnnot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Typedef srcAnnot -> m (Typedef srcAnnot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Typedef srcAnnot -> m (Typedef srcAnnot))
-> Data (Typedef srcAnnot)
Typedef srcAnnot -> Constr
Typedef srcAnnot -> DataType
(forall b. Data b => b -> b)
-> Typedef srcAnnot -> Typedef srcAnnot
forall srcAnnot. Data srcAnnot => Typeable (Typedef srcAnnot)
forall srcAnnot. Data srcAnnot => Typedef srcAnnot -> Constr
forall srcAnnot. Data srcAnnot => Typedef srcAnnot -> DataType
forall srcAnnot.
Data srcAnnot =>
(forall b. Data b => b -> b)
-> Typedef srcAnnot -> Typedef srcAnnot
forall srcAnnot u.
Data srcAnnot =>
Int -> (forall d. Data d => d -> u) -> Typedef srcAnnot -> u
forall srcAnnot u.
Data srcAnnot =>
(forall d. Data d => d -> u) -> Typedef srcAnnot -> [u]
forall srcAnnot r r'.
Data srcAnnot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Typedef srcAnnot -> r
forall srcAnnot r r'.
Data srcAnnot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Typedef srcAnnot -> r
forall srcAnnot (m :: * -> *).
(Data srcAnnot, Monad m) =>
(forall d. Data d => d -> m d)
-> Typedef srcAnnot -> m (Typedef srcAnnot)
forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Typedef srcAnnot -> m (Typedef srcAnnot)
forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Typedef srcAnnot)
forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Typedef srcAnnot -> c (Typedef srcAnnot)
forall srcAnnot (t :: * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Typedef srcAnnot))
forall srcAnnot (t :: * -> * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Typedef srcAnnot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> Typedef srcAnnot -> u
forall u. (forall d. Data d => d -> u) -> Typedef srcAnnot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Typedef srcAnnot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Typedef srcAnnot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Typedef srcAnnot -> m (Typedef srcAnnot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Typedef srcAnnot -> m (Typedef srcAnnot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Typedef srcAnnot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Typedef srcAnnot -> c (Typedef srcAnnot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Typedef srcAnnot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Typedef srcAnnot))
$cgfoldl :: forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Typedef srcAnnot -> c (Typedef srcAnnot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Typedef srcAnnot -> c (Typedef srcAnnot)
$cgunfold :: forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Typedef srcAnnot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Typedef srcAnnot)
$ctoConstr :: forall srcAnnot. Data srcAnnot => Typedef srcAnnot -> Constr
toConstr :: Typedef srcAnnot -> Constr
$cdataTypeOf :: forall srcAnnot. Data srcAnnot => Typedef srcAnnot -> DataType
dataTypeOf :: Typedef srcAnnot -> DataType
$cdataCast1 :: forall srcAnnot (t :: * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Typedef srcAnnot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Typedef srcAnnot))
$cdataCast2 :: forall srcAnnot (t :: * -> * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Typedef srcAnnot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Typedef srcAnnot))
$cgmapT :: forall srcAnnot.
Data srcAnnot =>
(forall b. Data b => b -> b)
-> Typedef srcAnnot -> Typedef srcAnnot
gmapT :: (forall b. Data b => b -> b)
-> Typedef srcAnnot -> Typedef srcAnnot
$cgmapQl :: forall srcAnnot r r'.
Data srcAnnot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Typedef srcAnnot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Typedef srcAnnot -> r
$cgmapQr :: forall srcAnnot r r'.
Data srcAnnot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Typedef srcAnnot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Typedef srcAnnot -> r
$cgmapQ :: forall srcAnnot u.
Data srcAnnot =>
(forall d. Data d => d -> u) -> Typedef srcAnnot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Typedef srcAnnot -> [u]
$cgmapQi :: forall srcAnnot u.
Data srcAnnot =>
Int -> (forall d. Data d => d -> u) -> Typedef srcAnnot -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> Typedef srcAnnot -> u
$cgmapM :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, Monad m) =>
(forall d. Data d => d -> m d)
-> Typedef srcAnnot -> m (Typedef srcAnnot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Typedef srcAnnot -> m (Typedef srcAnnot)
$cgmapMp :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Typedef srcAnnot -> m (Typedef srcAnnot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Typedef srcAnnot -> m (Typedef srcAnnot)
$cgmapMo :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Typedef srcAnnot -> m (Typedef srcAnnot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Typedef srcAnnot -> m (Typedef srcAnnot)
Data, Typeable, (forall x. Typedef srcAnnot -> Rep (Typedef srcAnnot) x)
-> (forall x. Rep (Typedef srcAnnot) x -> Typedef srcAnnot)
-> Generic (Typedef srcAnnot)
forall x. Rep (Typedef srcAnnot) x -> Typedef srcAnnot
forall x. Typedef srcAnnot -> Rep (Typedef srcAnnot) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall srcAnnot x. Rep (Typedef srcAnnot) x -> Typedef srcAnnot
forall srcAnnot x. Typedef srcAnnot -> Rep (Typedef srcAnnot) x
$cfrom :: forall srcAnnot x. Typedef srcAnnot -> Rep (Typedef srcAnnot) x
from :: forall x. Typedef srcAnnot -> Rep (Typedef srcAnnot) x
$cto :: forall srcAnnot x. Rep (Typedef srcAnnot) x -> Typedef srcAnnot
to :: forall x. Rep (Typedef srcAnnot) x -> Typedef srcAnnot
Generic, (forall a b. (a -> b) -> Typedef a -> Typedef b)
-> (forall a b. a -> Typedef b -> Typedef a) -> Functor Typedef
forall a b. a -> Typedef b -> Typedef a
forall a b. (a -> b) -> Typedef a -> Typedef b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Typedef a -> Typedef b
fmap :: forall a b. (a -> b) -> Typedef a -> Typedef b
$c<$ :: forall a b. a -> Typedef b -> Typedef a
<$ :: forall a b. a -> Typedef b -> Typedef a
Functor)

targetType :: Lens (Typedef a) (TypeReference a)
targetType :: forall a (f :: * -> *).
Functor f =>
(TypeReference a -> f (TypeReference a))
-> Typedef a -> f (Typedef a)
targetType = (Typedef a -> TypeReference a)
-> (Typedef a -> TypeReference a -> Typedef a)
-> Lens (Typedef a) (TypeReference a)
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Typedef a -> TypeReference a
forall srcAnnot. Typedef srcAnnot -> TypeReference srcAnnot
typedefTargetType (\Typedef a
s TypeReference a
a -> Typedef a
s { typedefTargetType = a })

instance HasName (Typedef a) where
    name :: Lens (Typedef a) Text
name = (Typedef a -> Text)
-> (Typedef a -> Text -> Typedef a) -> Lens (Typedef a) Text
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Typedef a -> Text
forall srcAnnot. Typedef srcAnnot -> Text
typedefName (\Typedef a
s Text
a -> Typedef a
s { typedefName = a })

instance HasSrcAnnot Typedef where
    srcAnnot :: forall a. Lens (Typedef a) a
srcAnnot = (Typedef a -> a)
-> (Typedef a -> a -> Typedef a) -> Lens (Typedef a) a
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Typedef a -> a
forall srcAnnot. Typedef srcAnnot -> srcAnnot
typedefSrcAnnot (\Typedef a
s a
a -> Typedef a
s { typedefSrcAnnot = a })

instance HasDocstring (Typedef a) where
    docstring :: Lens (Typedef a) (Maybe Text)
docstring = (Typedef a -> Maybe Text)
-> (Typedef a -> Maybe Text -> Typedef a)
-> Lens (Typedef a) (Maybe Text)
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Typedef a -> Maybe Text
forall srcAnnot. Typedef srcAnnot -> Maybe Text
typedefDocstring (\Typedef a
s Maybe Text
a -> Typedef a
s { typedefDocstring = a })

instance HasAnnotations (Typedef a) where
    annotations :: Lens (Typedef a) [TypeAnnotation]
annotations = (Typedef a -> [TypeAnnotation])
-> (Typedef a -> [TypeAnnotation] -> Typedef a)
-> Lens (Typedef a) [TypeAnnotation]
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Typedef a -> [TypeAnnotation]
forall srcAnnot. Typedef srcAnnot -> [TypeAnnotation]
typedefAnnotations (\Typedef a
s [TypeAnnotation]
a -> Typedef a
s { typedefAnnotations = a })

-- | A named value inside an enum.
data EnumDef srcAnnot = EnumDef
    { forall srcAnnot. EnumDef srcAnnot -> Text
enumDefName        :: Text
    -- ^ Name of the value.
    , forall srcAnnot. EnumDef srcAnnot -> Maybe Integer
enumDefValue       :: Maybe Integer
    -- ^ Value attached to the enum for that name.
    , forall srcAnnot. EnumDef srcAnnot -> [TypeAnnotation]
enumDefAnnotations :: [TypeAnnotation]
    -- ^ Annotations added to this enum field.
    , forall srcAnnot. EnumDef srcAnnot -> Maybe Text
enumDefDocstring   :: Docstring
    -- ^ Documentation
    , forall srcAnnot. EnumDef srcAnnot -> srcAnnot
enumDefSrcAnnot    :: srcAnnot
    }
  deriving (Int -> EnumDef srcAnnot -> ShowS
[EnumDef srcAnnot] -> ShowS
EnumDef srcAnnot -> String
(Int -> EnumDef srcAnnot -> ShowS)
-> (EnumDef srcAnnot -> String)
-> ([EnumDef srcAnnot] -> ShowS)
-> Show (EnumDef srcAnnot)
forall srcAnnot. Show srcAnnot => Int -> EnumDef srcAnnot -> ShowS
forall srcAnnot. Show srcAnnot => [EnumDef srcAnnot] -> ShowS
forall srcAnnot. Show srcAnnot => EnumDef srcAnnot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall srcAnnot. Show srcAnnot => Int -> EnumDef srcAnnot -> ShowS
showsPrec :: Int -> EnumDef srcAnnot -> ShowS
$cshow :: forall srcAnnot. Show srcAnnot => EnumDef srcAnnot -> String
show :: EnumDef srcAnnot -> String
$cshowList :: forall srcAnnot. Show srcAnnot => [EnumDef srcAnnot] -> ShowS
showList :: [EnumDef srcAnnot] -> ShowS
Show, Eq (EnumDef srcAnnot)
Eq (EnumDef srcAnnot) =>
(EnumDef srcAnnot -> EnumDef srcAnnot -> Ordering)
-> (EnumDef srcAnnot -> EnumDef srcAnnot -> Bool)
-> (EnumDef srcAnnot -> EnumDef srcAnnot -> Bool)
-> (EnumDef srcAnnot -> EnumDef srcAnnot -> Bool)
-> (EnumDef srcAnnot -> EnumDef srcAnnot -> Bool)
-> (EnumDef srcAnnot -> EnumDef srcAnnot -> EnumDef srcAnnot)
-> (EnumDef srcAnnot -> EnumDef srcAnnot -> EnumDef srcAnnot)
-> Ord (EnumDef srcAnnot)
EnumDef srcAnnot -> EnumDef srcAnnot -> Bool
EnumDef srcAnnot -> EnumDef srcAnnot -> Ordering
EnumDef srcAnnot -> EnumDef srcAnnot -> EnumDef srcAnnot
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 srcAnnot. Ord srcAnnot => Eq (EnumDef srcAnnot)
forall srcAnnot.
Ord srcAnnot =>
EnumDef srcAnnot -> EnumDef srcAnnot -> Bool
forall srcAnnot.
Ord srcAnnot =>
EnumDef srcAnnot -> EnumDef srcAnnot -> Ordering
forall srcAnnot.
Ord srcAnnot =>
EnumDef srcAnnot -> EnumDef srcAnnot -> EnumDef srcAnnot
$ccompare :: forall srcAnnot.
Ord srcAnnot =>
EnumDef srcAnnot -> EnumDef srcAnnot -> Ordering
compare :: EnumDef srcAnnot -> EnumDef srcAnnot -> Ordering
$c< :: forall srcAnnot.
Ord srcAnnot =>
EnumDef srcAnnot -> EnumDef srcAnnot -> Bool
< :: EnumDef srcAnnot -> EnumDef srcAnnot -> Bool
$c<= :: forall srcAnnot.
Ord srcAnnot =>
EnumDef srcAnnot -> EnumDef srcAnnot -> Bool
<= :: EnumDef srcAnnot -> EnumDef srcAnnot -> Bool
$c> :: forall srcAnnot.
Ord srcAnnot =>
EnumDef srcAnnot -> EnumDef srcAnnot -> Bool
> :: EnumDef srcAnnot -> EnumDef srcAnnot -> Bool
$c>= :: forall srcAnnot.
Ord srcAnnot =>
EnumDef srcAnnot -> EnumDef srcAnnot -> Bool
>= :: EnumDef srcAnnot -> EnumDef srcAnnot -> Bool
$cmax :: forall srcAnnot.
Ord srcAnnot =>
EnumDef srcAnnot -> EnumDef srcAnnot -> EnumDef srcAnnot
max :: EnumDef srcAnnot -> EnumDef srcAnnot -> EnumDef srcAnnot
$cmin :: forall srcAnnot.
Ord srcAnnot =>
EnumDef srcAnnot -> EnumDef srcAnnot -> EnumDef srcAnnot
min :: EnumDef srcAnnot -> EnumDef srcAnnot -> EnumDef srcAnnot
Ord, EnumDef srcAnnot -> EnumDef srcAnnot -> Bool
(EnumDef srcAnnot -> EnumDef srcAnnot -> Bool)
-> (EnumDef srcAnnot -> EnumDef srcAnnot -> Bool)
-> Eq (EnumDef srcAnnot)
forall srcAnnot.
Eq srcAnnot =>
EnumDef srcAnnot -> EnumDef srcAnnot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall srcAnnot.
Eq srcAnnot =>
EnumDef srcAnnot -> EnumDef srcAnnot -> Bool
== :: EnumDef srcAnnot -> EnumDef srcAnnot -> Bool
$c/= :: forall srcAnnot.
Eq srcAnnot =>
EnumDef srcAnnot -> EnumDef srcAnnot -> Bool
/= :: EnumDef srcAnnot -> EnumDef srcAnnot -> Bool
Eq, Typeable (EnumDef srcAnnot)
Typeable (EnumDef srcAnnot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> EnumDef srcAnnot
 -> c (EnumDef srcAnnot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (EnumDef srcAnnot))
-> (EnumDef srcAnnot -> Constr)
-> (EnumDef srcAnnot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (EnumDef srcAnnot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (EnumDef srcAnnot)))
-> ((forall b. Data b => b -> b)
    -> EnumDef srcAnnot -> EnumDef srcAnnot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> EnumDef srcAnnot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> EnumDef srcAnnot -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> EnumDef srcAnnot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> EnumDef srcAnnot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> EnumDef srcAnnot -> m (EnumDef srcAnnot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> EnumDef srcAnnot -> m (EnumDef srcAnnot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> EnumDef srcAnnot -> m (EnumDef srcAnnot))
-> Data (EnumDef srcAnnot)
EnumDef srcAnnot -> Constr
EnumDef srcAnnot -> DataType
(forall b. Data b => b -> b)
-> EnumDef srcAnnot -> EnumDef srcAnnot
forall srcAnnot. Data srcAnnot => Typeable (EnumDef srcAnnot)
forall srcAnnot. Data srcAnnot => EnumDef srcAnnot -> Constr
forall srcAnnot. Data srcAnnot => EnumDef srcAnnot -> DataType
forall srcAnnot.
Data srcAnnot =>
(forall b. Data b => b -> b)
-> EnumDef srcAnnot -> EnumDef srcAnnot
forall srcAnnot u.
Data srcAnnot =>
Int -> (forall d. Data d => d -> u) -> EnumDef srcAnnot -> u
forall srcAnnot u.
Data srcAnnot =>
(forall d. Data d => d -> u) -> EnumDef srcAnnot -> [u]
forall srcAnnot r r'.
Data srcAnnot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EnumDef srcAnnot -> r
forall srcAnnot r r'.
Data srcAnnot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EnumDef srcAnnot -> r
forall srcAnnot (m :: * -> *).
(Data srcAnnot, Monad m) =>
(forall d. Data d => d -> m d)
-> EnumDef srcAnnot -> m (EnumDef srcAnnot)
forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> EnumDef srcAnnot -> m (EnumDef srcAnnot)
forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (EnumDef srcAnnot)
forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EnumDef srcAnnot -> c (EnumDef srcAnnot)
forall srcAnnot (t :: * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (EnumDef srcAnnot))
forall srcAnnot (t :: * -> * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (EnumDef srcAnnot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> EnumDef srcAnnot -> u
forall u. (forall d. Data d => d -> u) -> EnumDef srcAnnot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EnumDef srcAnnot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EnumDef srcAnnot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> EnumDef srcAnnot -> m (EnumDef srcAnnot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EnumDef srcAnnot -> m (EnumDef srcAnnot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (EnumDef srcAnnot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EnumDef srcAnnot -> c (EnumDef srcAnnot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (EnumDef srcAnnot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (EnumDef srcAnnot))
$cgfoldl :: forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EnumDef srcAnnot -> c (EnumDef srcAnnot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EnumDef srcAnnot -> c (EnumDef srcAnnot)
$cgunfold :: forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (EnumDef srcAnnot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (EnumDef srcAnnot)
$ctoConstr :: forall srcAnnot. Data srcAnnot => EnumDef srcAnnot -> Constr
toConstr :: EnumDef srcAnnot -> Constr
$cdataTypeOf :: forall srcAnnot. Data srcAnnot => EnumDef srcAnnot -> DataType
dataTypeOf :: EnumDef srcAnnot -> DataType
$cdataCast1 :: forall srcAnnot (t :: * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (EnumDef srcAnnot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (EnumDef srcAnnot))
$cdataCast2 :: forall srcAnnot (t :: * -> * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (EnumDef srcAnnot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (EnumDef srcAnnot))
$cgmapT :: forall srcAnnot.
Data srcAnnot =>
(forall b. Data b => b -> b)
-> EnumDef srcAnnot -> EnumDef srcAnnot
gmapT :: (forall b. Data b => b -> b)
-> EnumDef srcAnnot -> EnumDef srcAnnot
$cgmapQl :: forall srcAnnot r r'.
Data srcAnnot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EnumDef srcAnnot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EnumDef srcAnnot -> r
$cgmapQr :: forall srcAnnot r r'.
Data srcAnnot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EnumDef srcAnnot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EnumDef srcAnnot -> r
$cgmapQ :: forall srcAnnot u.
Data srcAnnot =>
(forall d. Data d => d -> u) -> EnumDef srcAnnot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> EnumDef srcAnnot -> [u]
$cgmapQi :: forall srcAnnot u.
Data srcAnnot =>
Int -> (forall d. Data d => d -> u) -> EnumDef srcAnnot -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> EnumDef srcAnnot -> u
$cgmapM :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, Monad m) =>
(forall d. Data d => d -> m d)
-> EnumDef srcAnnot -> m (EnumDef srcAnnot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> EnumDef srcAnnot -> m (EnumDef srcAnnot)
$cgmapMp :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> EnumDef srcAnnot -> m (EnumDef srcAnnot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EnumDef srcAnnot -> m (EnumDef srcAnnot)
$cgmapMo :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> EnumDef srcAnnot -> m (EnumDef srcAnnot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EnumDef srcAnnot -> m (EnumDef srcAnnot)
Data, Typeable, (forall x. EnumDef srcAnnot -> Rep (EnumDef srcAnnot) x)
-> (forall x. Rep (EnumDef srcAnnot) x -> EnumDef srcAnnot)
-> Generic (EnumDef srcAnnot)
forall x. Rep (EnumDef srcAnnot) x -> EnumDef srcAnnot
forall x. EnumDef srcAnnot -> Rep (EnumDef srcAnnot) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall srcAnnot x. Rep (EnumDef srcAnnot) x -> EnumDef srcAnnot
forall srcAnnot x. EnumDef srcAnnot -> Rep (EnumDef srcAnnot) x
$cfrom :: forall srcAnnot x. EnumDef srcAnnot -> Rep (EnumDef srcAnnot) x
from :: forall x. EnumDef srcAnnot -> Rep (EnumDef srcAnnot) x
$cto :: forall srcAnnot x. Rep (EnumDef srcAnnot) x -> EnumDef srcAnnot
to :: forall x. Rep (EnumDef srcAnnot) x -> EnumDef srcAnnot
Generic, (forall a b. (a -> b) -> EnumDef a -> EnumDef b)
-> (forall a b. a -> EnumDef b -> EnumDef a) -> Functor EnumDef
forall a b. a -> EnumDef b -> EnumDef a
forall a b. (a -> b) -> EnumDef a -> EnumDef b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> EnumDef a -> EnumDef b
fmap :: forall a b. (a -> b) -> EnumDef a -> EnumDef b
$c<$ :: forall a b. a -> EnumDef b -> EnumDef a
<$ :: forall a b. a -> EnumDef b -> EnumDef a
Functor)

instance HasValue (EnumDef a) (Maybe Integer) where
    value :: Lens (EnumDef a) (Maybe Integer)
value = (EnumDef a -> Maybe Integer)
-> (EnumDef a -> Maybe Integer -> EnumDef a)
-> Lens (EnumDef a) (Maybe Integer)
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens EnumDef a -> Maybe Integer
forall srcAnnot. EnumDef srcAnnot -> Maybe Integer
enumDefValue (\EnumDef a
s Maybe Integer
a -> EnumDef a
s { enumDefValue = a })

instance HasName (EnumDef a) where
    name :: Lens (EnumDef a) Text
name = (EnumDef a -> Text)
-> (EnumDef a -> Text -> EnumDef a) -> Lens (EnumDef a) Text
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens EnumDef a -> Text
forall srcAnnot. EnumDef srcAnnot -> Text
enumDefName (\EnumDef a
s Text
a -> EnumDef a
s { enumDefName = a })

instance HasSrcAnnot EnumDef where
    srcAnnot :: forall a. Lens (EnumDef a) a
srcAnnot = (EnumDef a -> a)
-> (EnumDef a -> a -> EnumDef a) -> Lens (EnumDef a) a
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens EnumDef a -> a
forall srcAnnot. EnumDef srcAnnot -> srcAnnot
enumDefSrcAnnot (\EnumDef a
s a
a -> EnumDef a
s { enumDefSrcAnnot = a })

instance HasDocstring (EnumDef a) where
    docstring :: Lens (EnumDef a) (Maybe Text)
docstring = (EnumDef a -> Maybe Text)
-> (EnumDef a -> Maybe Text -> EnumDef a)
-> Lens (EnumDef a) (Maybe Text)
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens EnumDef a -> Maybe Text
forall srcAnnot. EnumDef srcAnnot -> Maybe Text
enumDefDocstring (\EnumDef a
s Maybe Text
a -> EnumDef a
s { enumDefDocstring = a })

instance HasAnnotations (EnumDef a) where
    annotations :: Lens (EnumDef a) [TypeAnnotation]
annotations = (EnumDef a -> [TypeAnnotation])
-> (EnumDef a -> [TypeAnnotation] -> EnumDef a)
-> Lens (EnumDef a) [TypeAnnotation]
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens EnumDef a -> [TypeAnnotation]
forall srcAnnot. EnumDef srcAnnot -> [TypeAnnotation]
enumDefAnnotations (\EnumDef a
s [TypeAnnotation]
a -> EnumDef a
s { enumDefAnnotations = a })

-- | Enums are sets of named integer values.
--
-- > enum Role {
-- >     User = 1, Admin = 2
-- > }
data Enum srcAnnot = Enum
    { forall srcAnnot. Enum srcAnnot -> Text
enumName        :: Text
    -- ^ Name of the enum type.
    , forall srcAnnot. Enum srcAnnot -> [EnumDef srcAnnot]
enumValues      :: [EnumDef srcAnnot]
    -- ^ Values defined in the enum.
    , forall srcAnnot. Enum srcAnnot -> [TypeAnnotation]
enumAnnotations :: [TypeAnnotation]
    -- ^ Annotations added to the enum.
    , forall srcAnnot. Enum srcAnnot -> Maybe Text
enumDocstring   :: Docstring
    -- ^ Documentation.
    , forall srcAnnot. Enum srcAnnot -> srcAnnot
enumSrcAnnot    :: srcAnnot
    }
  deriving (Int -> Enum srcAnnot -> ShowS
[Enum srcAnnot] -> ShowS
Enum srcAnnot -> String
(Int -> Enum srcAnnot -> ShowS)
-> (Enum srcAnnot -> String)
-> ([Enum srcAnnot] -> ShowS)
-> Show (Enum srcAnnot)
forall srcAnnot. Show srcAnnot => Int -> Enum srcAnnot -> ShowS
forall srcAnnot. Show srcAnnot => [Enum srcAnnot] -> ShowS
forall srcAnnot. Show srcAnnot => Enum srcAnnot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall srcAnnot. Show srcAnnot => Int -> Enum srcAnnot -> ShowS
showsPrec :: Int -> Enum srcAnnot -> ShowS
$cshow :: forall srcAnnot. Show srcAnnot => Enum srcAnnot -> String
show :: Enum srcAnnot -> String
$cshowList :: forall srcAnnot. Show srcAnnot => [Enum srcAnnot] -> ShowS
showList :: [Enum srcAnnot] -> ShowS
Show, Eq (Enum srcAnnot)
Eq (Enum srcAnnot) =>
(Enum srcAnnot -> Enum srcAnnot -> Ordering)
-> (Enum srcAnnot -> Enum srcAnnot -> Bool)
-> (Enum srcAnnot -> Enum srcAnnot -> Bool)
-> (Enum srcAnnot -> Enum srcAnnot -> Bool)
-> (Enum srcAnnot -> Enum srcAnnot -> Bool)
-> (Enum srcAnnot -> Enum srcAnnot -> Enum srcAnnot)
-> (Enum srcAnnot -> Enum srcAnnot -> Enum srcAnnot)
-> Ord (Enum srcAnnot)
Enum srcAnnot -> Enum srcAnnot -> Bool
Enum srcAnnot -> Enum srcAnnot -> Ordering
Enum srcAnnot -> Enum srcAnnot -> Enum srcAnnot
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 srcAnnot. Ord srcAnnot => Eq (Enum srcAnnot)
forall srcAnnot.
Ord srcAnnot =>
Enum srcAnnot -> Enum srcAnnot -> Bool
forall srcAnnot.
Ord srcAnnot =>
Enum srcAnnot -> Enum srcAnnot -> Ordering
forall srcAnnot.
Ord srcAnnot =>
Enum srcAnnot -> Enum srcAnnot -> Enum srcAnnot
$ccompare :: forall srcAnnot.
Ord srcAnnot =>
Enum srcAnnot -> Enum srcAnnot -> Ordering
compare :: Enum srcAnnot -> Enum srcAnnot -> Ordering
$c< :: forall srcAnnot.
Ord srcAnnot =>
Enum srcAnnot -> Enum srcAnnot -> Bool
< :: Enum srcAnnot -> Enum srcAnnot -> Bool
$c<= :: forall srcAnnot.
Ord srcAnnot =>
Enum srcAnnot -> Enum srcAnnot -> Bool
<= :: Enum srcAnnot -> Enum srcAnnot -> Bool
$c> :: forall srcAnnot.
Ord srcAnnot =>
Enum srcAnnot -> Enum srcAnnot -> Bool
> :: Enum srcAnnot -> Enum srcAnnot -> Bool
$c>= :: forall srcAnnot.
Ord srcAnnot =>
Enum srcAnnot -> Enum srcAnnot -> Bool
>= :: Enum srcAnnot -> Enum srcAnnot -> Bool
$cmax :: forall srcAnnot.
Ord srcAnnot =>
Enum srcAnnot -> Enum srcAnnot -> Enum srcAnnot
max :: Enum srcAnnot -> Enum srcAnnot -> Enum srcAnnot
$cmin :: forall srcAnnot.
Ord srcAnnot =>
Enum srcAnnot -> Enum srcAnnot -> Enum srcAnnot
min :: Enum srcAnnot -> Enum srcAnnot -> Enum srcAnnot
Ord, Enum srcAnnot -> Enum srcAnnot -> Bool
(Enum srcAnnot -> Enum srcAnnot -> Bool)
-> (Enum srcAnnot -> Enum srcAnnot -> Bool) -> Eq (Enum srcAnnot)
forall srcAnnot.
Eq srcAnnot =>
Enum srcAnnot -> Enum srcAnnot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall srcAnnot.
Eq srcAnnot =>
Enum srcAnnot -> Enum srcAnnot -> Bool
== :: Enum srcAnnot -> Enum srcAnnot -> Bool
$c/= :: forall srcAnnot.
Eq srcAnnot =>
Enum srcAnnot -> Enum srcAnnot -> Bool
/= :: Enum srcAnnot -> Enum srcAnnot -> Bool
Eq, Typeable (Enum srcAnnot)
Typeable (Enum srcAnnot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Enum srcAnnot -> c (Enum srcAnnot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Enum srcAnnot))
-> (Enum srcAnnot -> Constr)
-> (Enum srcAnnot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Enum srcAnnot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Enum srcAnnot)))
-> ((forall b. Data b => b -> b) -> Enum srcAnnot -> Enum srcAnnot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Enum srcAnnot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Enum srcAnnot -> r)
-> (forall u. (forall d. Data d => d -> u) -> Enum srcAnnot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Enum srcAnnot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> Enum srcAnnot -> m (Enum srcAnnot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Enum srcAnnot -> m (Enum srcAnnot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Enum srcAnnot -> m (Enum srcAnnot))
-> Data (Enum srcAnnot)
Enum srcAnnot -> Constr
Enum srcAnnot -> DataType
(forall b. Data b => b -> b) -> Enum srcAnnot -> Enum srcAnnot
forall srcAnnot. Data srcAnnot => Typeable (Enum srcAnnot)
forall srcAnnot. Data srcAnnot => Enum srcAnnot -> Constr
forall srcAnnot. Data srcAnnot => Enum srcAnnot -> DataType
forall srcAnnot.
Data srcAnnot =>
(forall b. Data b => b -> b) -> Enum srcAnnot -> Enum srcAnnot
forall srcAnnot u.
Data srcAnnot =>
Int -> (forall d. Data d => d -> u) -> Enum srcAnnot -> u
forall srcAnnot u.
Data srcAnnot =>
(forall d. Data d => d -> u) -> Enum srcAnnot -> [u]
forall srcAnnot r r'.
Data srcAnnot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Enum srcAnnot -> r
forall srcAnnot r r'.
Data srcAnnot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Enum srcAnnot -> r
forall srcAnnot (m :: * -> *).
(Data srcAnnot, Monad m) =>
(forall d. Data d => d -> m d)
-> Enum srcAnnot -> m (Enum srcAnnot)
forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Enum srcAnnot -> m (Enum srcAnnot)
forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Enum srcAnnot)
forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Enum srcAnnot -> c (Enum srcAnnot)
forall srcAnnot (t :: * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Enum srcAnnot))
forall srcAnnot (t :: * -> * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Enum srcAnnot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Enum srcAnnot -> u
forall u. (forall d. Data d => d -> u) -> Enum srcAnnot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Enum srcAnnot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Enum srcAnnot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Enum srcAnnot -> m (Enum srcAnnot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Enum srcAnnot -> m (Enum srcAnnot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Enum srcAnnot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Enum srcAnnot -> c (Enum srcAnnot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Enum srcAnnot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Enum srcAnnot))
$cgfoldl :: forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Enum srcAnnot -> c (Enum srcAnnot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Enum srcAnnot -> c (Enum srcAnnot)
$cgunfold :: forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Enum srcAnnot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Enum srcAnnot)
$ctoConstr :: forall srcAnnot. Data srcAnnot => Enum srcAnnot -> Constr
toConstr :: Enum srcAnnot -> Constr
$cdataTypeOf :: forall srcAnnot. Data srcAnnot => Enum srcAnnot -> DataType
dataTypeOf :: Enum srcAnnot -> DataType
$cdataCast1 :: forall srcAnnot (t :: * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Enum srcAnnot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Enum srcAnnot))
$cdataCast2 :: forall srcAnnot (t :: * -> * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Enum srcAnnot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Enum srcAnnot))
$cgmapT :: forall srcAnnot.
Data srcAnnot =>
(forall b. Data b => b -> b) -> Enum srcAnnot -> Enum srcAnnot
gmapT :: (forall b. Data b => b -> b) -> Enum srcAnnot -> Enum srcAnnot
$cgmapQl :: forall srcAnnot r r'.
Data srcAnnot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Enum srcAnnot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Enum srcAnnot -> r
$cgmapQr :: forall srcAnnot r r'.
Data srcAnnot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Enum srcAnnot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Enum srcAnnot -> r
$cgmapQ :: forall srcAnnot u.
Data srcAnnot =>
(forall d. Data d => d -> u) -> Enum srcAnnot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Enum srcAnnot -> [u]
$cgmapQi :: forall srcAnnot u.
Data srcAnnot =>
Int -> (forall d. Data d => d -> u) -> Enum srcAnnot -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Enum srcAnnot -> u
$cgmapM :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, Monad m) =>
(forall d. Data d => d -> m d)
-> Enum srcAnnot -> m (Enum srcAnnot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Enum srcAnnot -> m (Enum srcAnnot)
$cgmapMp :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Enum srcAnnot -> m (Enum srcAnnot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Enum srcAnnot -> m (Enum srcAnnot)
$cgmapMo :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Enum srcAnnot -> m (Enum srcAnnot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Enum srcAnnot -> m (Enum srcAnnot)
Data, Typeable, (forall x. Enum srcAnnot -> Rep (Enum srcAnnot) x)
-> (forall x. Rep (Enum srcAnnot) x -> Enum srcAnnot)
-> Generic (Enum srcAnnot)
forall x. Rep (Enum srcAnnot) x -> Enum srcAnnot
forall x. Enum srcAnnot -> Rep (Enum srcAnnot) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall srcAnnot x. Rep (Enum srcAnnot) x -> Enum srcAnnot
forall srcAnnot x. Enum srcAnnot -> Rep (Enum srcAnnot) x
$cfrom :: forall srcAnnot x. Enum srcAnnot -> Rep (Enum srcAnnot) x
from :: forall x. Enum srcAnnot -> Rep (Enum srcAnnot) x
$cto :: forall srcAnnot x. Rep (Enum srcAnnot) x -> Enum srcAnnot
to :: forall x. Rep (Enum srcAnnot) x -> Enum srcAnnot
Generic, (forall a b. (a -> b) -> Enum a -> Enum b)
-> (forall a b. a -> Enum b -> Enum a) -> Functor Enum
forall a b. a -> Enum b -> Enum a
forall a b. (a -> b) -> Enum a -> Enum b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Enum a -> Enum b
fmap :: forall a b. (a -> b) -> Enum a -> Enum b
$c<$ :: forall a b. a -> Enum b -> Enum a
<$ :: forall a b. a -> Enum b -> Enum a
Functor)

class HasValues s a | s -> a where
    values :: Lens s a

instance HasValues (Enum a) [EnumDef a] where
    values :: Lens (Enum a) [EnumDef a]
values = (Enum a -> [EnumDef a])
-> (Enum a -> [EnumDef a] -> Enum a) -> Lens (Enum a) [EnumDef a]
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Enum a -> [EnumDef a]
forall srcAnnot. Enum srcAnnot -> [EnumDef srcAnnot]
enumValues (\Enum a
s [EnumDef a]
a -> Enum a
s { enumValues = a })

instance HasName (Enum a) where
    name :: Lens (Enum a) Text
name = (Enum a -> Text)
-> (Enum a -> Text -> Enum a) -> Lens (Enum a) Text
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Enum a -> Text
forall srcAnnot. Enum srcAnnot -> Text
enumName (\Enum a
s Text
a -> Enum a
s { enumName = a })

instance HasSrcAnnot Enum where
    srcAnnot :: forall a. Lens (Enum a) a
srcAnnot = (Enum a -> a) -> (Enum a -> a -> Enum a) -> Lens (Enum a) a
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Enum a -> a
forall srcAnnot. Enum srcAnnot -> srcAnnot
enumSrcAnnot (\Enum a
s a
a -> Enum a
s { enumSrcAnnot = a })

instance HasDocstring (Enum a) where
    docstring :: Lens (Enum a) (Maybe Text)
docstring = (Enum a -> Maybe Text)
-> (Enum a -> Maybe Text -> Enum a) -> Lens (Enum a) (Maybe Text)
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Enum a -> Maybe Text
forall srcAnnot. Enum srcAnnot -> Maybe Text
enumDocstring (\Enum a
s Maybe Text
a -> Enum a
s { enumDocstring = a })

instance HasAnnotations (Enum a) where
    annotations :: Lens (Enum a) [TypeAnnotation]
annotations = (Enum a -> [TypeAnnotation])
-> (Enum a -> [TypeAnnotation] -> Enum a)
-> Lens (Enum a) [TypeAnnotation]
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Enum a -> [TypeAnnotation]
forall srcAnnot. Enum srcAnnot -> [TypeAnnotation]
enumAnnotations (\Enum a
s [TypeAnnotation]
a -> Enum a
s { enumAnnotations = a })

-- | The kind of the struct.
data StructKind
    = StructKind       -- ^ @struct@
    | UnionKind        -- ^ @union@
    | ExceptionKind    -- ^ @exception@
  deriving (Int -> StructKind -> ShowS
[StructKind] -> ShowS
StructKind -> String
(Int -> StructKind -> ShowS)
-> (StructKind -> String)
-> ([StructKind] -> ShowS)
-> Show StructKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StructKind -> ShowS
showsPrec :: Int -> StructKind -> ShowS
$cshow :: StructKind -> String
show :: StructKind -> String
$cshowList :: [StructKind] -> ShowS
showList :: [StructKind] -> ShowS
Show, Eq StructKind
Eq StructKind =>
(StructKind -> StructKind -> Ordering)
-> (StructKind -> StructKind -> Bool)
-> (StructKind -> StructKind -> Bool)
-> (StructKind -> StructKind -> Bool)
-> (StructKind -> StructKind -> Bool)
-> (StructKind -> StructKind -> StructKind)
-> (StructKind -> StructKind -> StructKind)
-> Ord StructKind
StructKind -> StructKind -> Bool
StructKind -> StructKind -> Ordering
StructKind -> StructKind -> StructKind
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: StructKind -> StructKind -> Ordering
compare :: StructKind -> StructKind -> Ordering
$c< :: StructKind -> StructKind -> Bool
< :: StructKind -> StructKind -> Bool
$c<= :: StructKind -> StructKind -> Bool
<= :: StructKind -> StructKind -> Bool
$c> :: StructKind -> StructKind -> Bool
> :: StructKind -> StructKind -> Bool
$c>= :: StructKind -> StructKind -> Bool
>= :: StructKind -> StructKind -> Bool
$cmax :: StructKind -> StructKind -> StructKind
max :: StructKind -> StructKind -> StructKind
$cmin :: StructKind -> StructKind -> StructKind
min :: StructKind -> StructKind -> StructKind
Ord, StructKind -> StructKind -> Bool
(StructKind -> StructKind -> Bool)
-> (StructKind -> StructKind -> Bool) -> Eq StructKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StructKind -> StructKind -> Bool
== :: StructKind -> StructKind -> Bool
$c/= :: StructKind -> StructKind -> Bool
/= :: StructKind -> StructKind -> Bool
Eq, Typeable StructKind
Typeable StructKind =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> StructKind -> c StructKind)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c StructKind)
-> (StructKind -> Constr)
-> (StructKind -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c StructKind))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c StructKind))
-> ((forall b. Data b => b -> b) -> StructKind -> StructKind)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> StructKind -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> StructKind -> r)
-> (forall u. (forall d. Data d => d -> u) -> StructKind -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> StructKind -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> StructKind -> m StructKind)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> StructKind -> m StructKind)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> StructKind -> m StructKind)
-> Data StructKind
StructKind -> Constr
StructKind -> DataType
(forall b. Data b => b -> b) -> StructKind -> StructKind
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> StructKind -> u
forall u. (forall d. Data d => d -> u) -> StructKind -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StructKind -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StructKind -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> StructKind -> m StructKind
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StructKind -> m StructKind
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StructKind
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StructKind -> c StructKind
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StructKind)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c StructKind)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StructKind -> c StructKind
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StructKind -> c StructKind
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StructKind
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StructKind
$ctoConstr :: StructKind -> Constr
toConstr :: StructKind -> Constr
$cdataTypeOf :: StructKind -> DataType
dataTypeOf :: StructKind -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StructKind)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StructKind)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c StructKind)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c StructKind)
$cgmapT :: (forall b. Data b => b -> b) -> StructKind -> StructKind
gmapT :: (forall b. Data b => b -> b) -> StructKind -> StructKind
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StructKind -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StructKind -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StructKind -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StructKind -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> StructKind -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> StructKind -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> StructKind -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> StructKind -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> StructKind -> m StructKind
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> StructKind -> m StructKind
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StructKind -> m StructKind
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StructKind -> m StructKind
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StructKind -> m StructKind
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StructKind -> m StructKind
Data, Typeable, (forall x. StructKind -> Rep StructKind x)
-> (forall x. Rep StructKind x -> StructKind) -> Generic StructKind
forall x. Rep StructKind x -> StructKind
forall x. StructKind -> Rep StructKind x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StructKind -> Rep StructKind x
from :: forall x. StructKind -> Rep StructKind x
$cto :: forall x. Rep StructKind x -> StructKind
to :: forall x. Rep StructKind x -> StructKind
Generic)

-- | A struct, union, or exception definition.
--
-- > struct User {
-- >     1: Role role = Role.User;
-- > }
--
-- > union Value {
-- >     1: string stringValue;
-- >     2: i32 intValue;
-- > }
--
-- > exception UserDoesNotExist {
-- >     1: optional string message
-- >     2: required string username
-- > }
data Struct srcAnnot = Struct
    { forall srcAnnot. Struct srcAnnot -> StructKind
structKind        :: StructKind
    -- ^ Kind of the structure.
    , forall srcAnnot. Struct srcAnnot -> Text
structName        :: Text
    -- ^ Name of the struct.
    , forall srcAnnot. Struct srcAnnot -> [Field srcAnnot]
structFields      :: [Field srcAnnot]
    -- ^ Fields defined in the struct.
    , forall srcAnnot. Struct srcAnnot -> [TypeAnnotation]
structAnnotations :: [TypeAnnotation]
    -- ^ Annotations added to the struct.
    , forall srcAnnot. Struct srcAnnot -> Maybe Text
structDocstring   :: Docstring
    -- ^ Documentation.
    , forall srcAnnot. Struct srcAnnot -> srcAnnot
structSrcAnnot    :: srcAnnot
    }
  deriving (Int -> Struct srcAnnot -> ShowS
[Struct srcAnnot] -> ShowS
Struct srcAnnot -> String
(Int -> Struct srcAnnot -> ShowS)
-> (Struct srcAnnot -> String)
-> ([Struct srcAnnot] -> ShowS)
-> Show (Struct srcAnnot)
forall srcAnnot. Show srcAnnot => Int -> Struct srcAnnot -> ShowS
forall srcAnnot. Show srcAnnot => [Struct srcAnnot] -> ShowS
forall srcAnnot. Show srcAnnot => Struct srcAnnot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall srcAnnot. Show srcAnnot => Int -> Struct srcAnnot -> ShowS
showsPrec :: Int -> Struct srcAnnot -> ShowS
$cshow :: forall srcAnnot. Show srcAnnot => Struct srcAnnot -> String
show :: Struct srcAnnot -> String
$cshowList :: forall srcAnnot. Show srcAnnot => [Struct srcAnnot] -> ShowS
showList :: [Struct srcAnnot] -> ShowS
Show, Eq (Struct srcAnnot)
Eq (Struct srcAnnot) =>
(Struct srcAnnot -> Struct srcAnnot -> Ordering)
-> (Struct srcAnnot -> Struct srcAnnot -> Bool)
-> (Struct srcAnnot -> Struct srcAnnot -> Bool)
-> (Struct srcAnnot -> Struct srcAnnot -> Bool)
-> (Struct srcAnnot -> Struct srcAnnot -> Bool)
-> (Struct srcAnnot -> Struct srcAnnot -> Struct srcAnnot)
-> (Struct srcAnnot -> Struct srcAnnot -> Struct srcAnnot)
-> Ord (Struct srcAnnot)
Struct srcAnnot -> Struct srcAnnot -> Bool
Struct srcAnnot -> Struct srcAnnot -> Ordering
Struct srcAnnot -> Struct srcAnnot -> Struct srcAnnot
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 srcAnnot. Ord srcAnnot => Eq (Struct srcAnnot)
forall srcAnnot.
Ord srcAnnot =>
Struct srcAnnot -> Struct srcAnnot -> Bool
forall srcAnnot.
Ord srcAnnot =>
Struct srcAnnot -> Struct srcAnnot -> Ordering
forall srcAnnot.
Ord srcAnnot =>
Struct srcAnnot -> Struct srcAnnot -> Struct srcAnnot
$ccompare :: forall srcAnnot.
Ord srcAnnot =>
Struct srcAnnot -> Struct srcAnnot -> Ordering
compare :: Struct srcAnnot -> Struct srcAnnot -> Ordering
$c< :: forall srcAnnot.
Ord srcAnnot =>
Struct srcAnnot -> Struct srcAnnot -> Bool
< :: Struct srcAnnot -> Struct srcAnnot -> Bool
$c<= :: forall srcAnnot.
Ord srcAnnot =>
Struct srcAnnot -> Struct srcAnnot -> Bool
<= :: Struct srcAnnot -> Struct srcAnnot -> Bool
$c> :: forall srcAnnot.
Ord srcAnnot =>
Struct srcAnnot -> Struct srcAnnot -> Bool
> :: Struct srcAnnot -> Struct srcAnnot -> Bool
$c>= :: forall srcAnnot.
Ord srcAnnot =>
Struct srcAnnot -> Struct srcAnnot -> Bool
>= :: Struct srcAnnot -> Struct srcAnnot -> Bool
$cmax :: forall srcAnnot.
Ord srcAnnot =>
Struct srcAnnot -> Struct srcAnnot -> Struct srcAnnot
max :: Struct srcAnnot -> Struct srcAnnot -> Struct srcAnnot
$cmin :: forall srcAnnot.
Ord srcAnnot =>
Struct srcAnnot -> Struct srcAnnot -> Struct srcAnnot
min :: Struct srcAnnot -> Struct srcAnnot -> Struct srcAnnot
Ord, Struct srcAnnot -> Struct srcAnnot -> Bool
(Struct srcAnnot -> Struct srcAnnot -> Bool)
-> (Struct srcAnnot -> Struct srcAnnot -> Bool)
-> Eq (Struct srcAnnot)
forall srcAnnot.
Eq srcAnnot =>
Struct srcAnnot -> Struct srcAnnot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall srcAnnot.
Eq srcAnnot =>
Struct srcAnnot -> Struct srcAnnot -> Bool
== :: Struct srcAnnot -> Struct srcAnnot -> Bool
$c/= :: forall srcAnnot.
Eq srcAnnot =>
Struct srcAnnot -> Struct srcAnnot -> Bool
/= :: Struct srcAnnot -> Struct srcAnnot -> Bool
Eq, Typeable (Struct srcAnnot)
Typeable (Struct srcAnnot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Struct srcAnnot -> c (Struct srcAnnot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Struct srcAnnot))
-> (Struct srcAnnot -> Constr)
-> (Struct srcAnnot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Struct srcAnnot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Struct srcAnnot)))
-> ((forall b. Data b => b -> b)
    -> Struct srcAnnot -> Struct srcAnnot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Struct srcAnnot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Struct srcAnnot -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> Struct srcAnnot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Struct srcAnnot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> Struct srcAnnot -> m (Struct srcAnnot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Struct srcAnnot -> m (Struct srcAnnot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Struct srcAnnot -> m (Struct srcAnnot))
-> Data (Struct srcAnnot)
Struct srcAnnot -> Constr
Struct srcAnnot -> DataType
(forall b. Data b => b -> b) -> Struct srcAnnot -> Struct srcAnnot
forall srcAnnot. Data srcAnnot => Typeable (Struct srcAnnot)
forall srcAnnot. Data srcAnnot => Struct srcAnnot -> Constr
forall srcAnnot. Data srcAnnot => Struct srcAnnot -> DataType
forall srcAnnot.
Data srcAnnot =>
(forall b. Data b => b -> b) -> Struct srcAnnot -> Struct srcAnnot
forall srcAnnot u.
Data srcAnnot =>
Int -> (forall d. Data d => d -> u) -> Struct srcAnnot -> u
forall srcAnnot u.
Data srcAnnot =>
(forall d. Data d => d -> u) -> Struct srcAnnot -> [u]
forall srcAnnot r r'.
Data srcAnnot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Struct srcAnnot -> r
forall srcAnnot r r'.
Data srcAnnot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Struct srcAnnot -> r
forall srcAnnot (m :: * -> *).
(Data srcAnnot, Monad m) =>
(forall d. Data d => d -> m d)
-> Struct srcAnnot -> m (Struct srcAnnot)
forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Struct srcAnnot -> m (Struct srcAnnot)
forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Struct srcAnnot)
forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Struct srcAnnot -> c (Struct srcAnnot)
forall srcAnnot (t :: * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Struct srcAnnot))
forall srcAnnot (t :: * -> * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Struct srcAnnot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> Struct srcAnnot -> u
forall u. (forall d. Data d => d -> u) -> Struct srcAnnot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Struct srcAnnot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Struct srcAnnot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Struct srcAnnot -> m (Struct srcAnnot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Struct srcAnnot -> m (Struct srcAnnot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Struct srcAnnot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Struct srcAnnot -> c (Struct srcAnnot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Struct srcAnnot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Struct srcAnnot))
$cgfoldl :: forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Struct srcAnnot -> c (Struct srcAnnot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Struct srcAnnot -> c (Struct srcAnnot)
$cgunfold :: forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Struct srcAnnot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Struct srcAnnot)
$ctoConstr :: forall srcAnnot. Data srcAnnot => Struct srcAnnot -> Constr
toConstr :: Struct srcAnnot -> Constr
$cdataTypeOf :: forall srcAnnot. Data srcAnnot => Struct srcAnnot -> DataType
dataTypeOf :: Struct srcAnnot -> DataType
$cdataCast1 :: forall srcAnnot (t :: * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Struct srcAnnot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Struct srcAnnot))
$cdataCast2 :: forall srcAnnot (t :: * -> * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Struct srcAnnot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Struct srcAnnot))
$cgmapT :: forall srcAnnot.
Data srcAnnot =>
(forall b. Data b => b -> b) -> Struct srcAnnot -> Struct srcAnnot
gmapT :: (forall b. Data b => b -> b) -> Struct srcAnnot -> Struct srcAnnot
$cgmapQl :: forall srcAnnot r r'.
Data srcAnnot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Struct srcAnnot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Struct srcAnnot -> r
$cgmapQr :: forall srcAnnot r r'.
Data srcAnnot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Struct srcAnnot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Struct srcAnnot -> r
$cgmapQ :: forall srcAnnot u.
Data srcAnnot =>
(forall d. Data d => d -> u) -> Struct srcAnnot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Struct srcAnnot -> [u]
$cgmapQi :: forall srcAnnot u.
Data srcAnnot =>
Int -> (forall d. Data d => d -> u) -> Struct srcAnnot -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> Struct srcAnnot -> u
$cgmapM :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, Monad m) =>
(forall d. Data d => d -> m d)
-> Struct srcAnnot -> m (Struct srcAnnot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Struct srcAnnot -> m (Struct srcAnnot)
$cgmapMp :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Struct srcAnnot -> m (Struct srcAnnot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Struct srcAnnot -> m (Struct srcAnnot)
$cgmapMo :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Struct srcAnnot -> m (Struct srcAnnot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Struct srcAnnot -> m (Struct srcAnnot)
Data, Typeable, (forall x. Struct srcAnnot -> Rep (Struct srcAnnot) x)
-> (forall x. Rep (Struct srcAnnot) x -> Struct srcAnnot)
-> Generic (Struct srcAnnot)
forall x. Rep (Struct srcAnnot) x -> Struct srcAnnot
forall x. Struct srcAnnot -> Rep (Struct srcAnnot) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall srcAnnot x. Rep (Struct srcAnnot) x -> Struct srcAnnot
forall srcAnnot x. Struct srcAnnot -> Rep (Struct srcAnnot) x
$cfrom :: forall srcAnnot x. Struct srcAnnot -> Rep (Struct srcAnnot) x
from :: forall x. Struct srcAnnot -> Rep (Struct srcAnnot) x
$cto :: forall srcAnnot x. Rep (Struct srcAnnot) x -> Struct srcAnnot
to :: forall x. Rep (Struct srcAnnot) x -> Struct srcAnnot
Generic, (forall a b. (a -> b) -> Struct a -> Struct b)
-> (forall a b. a -> Struct b -> Struct a) -> Functor Struct
forall a b. a -> Struct b -> Struct a
forall a b. (a -> b) -> Struct a -> Struct b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Struct a -> Struct b
fmap :: forall a b. (a -> b) -> Struct a -> Struct b
$c<$ :: forall a b. a -> Struct b -> Struct a
<$ :: forall a b. a -> Struct b -> Struct a
Functor)

kind :: Lens (Struct a) StructKind
kind :: forall a (f :: * -> *).
Functor f =>
(StructKind -> f StructKind) -> Struct a -> f (Struct a)
kind = (Struct a -> StructKind)
-> (Struct a -> StructKind -> Struct a)
-> Lens (Struct a) StructKind
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Struct a -> StructKind
forall srcAnnot. Struct srcAnnot -> StructKind
structKind (\Struct a
s StructKind
a -> Struct a
s { structKind = a })

instance HasName (Struct a) where
    name :: Lens (Struct a) Text
name = (Struct a -> Text)
-> (Struct a -> Text -> Struct a) -> Lens (Struct a) Text
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Struct a -> Text
forall srcAnnot. Struct srcAnnot -> Text
structName (\Struct a
s Text
a -> Struct a
s { structName = a })

instance HasFields Struct where
    fields :: forall a. Lens (Struct a) [Field a]
fields = (Struct a -> [Field a])
-> (Struct a -> [Field a] -> Struct a) -> Lens (Struct a) [Field a]
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Struct a -> [Field a]
forall srcAnnot. Struct srcAnnot -> [Field srcAnnot]
structFields (\Struct a
s [Field a]
a -> Struct a
s { structFields = a })

instance HasSrcAnnot Struct where
    srcAnnot :: forall a. Lens (Struct a) a
srcAnnot = (Struct a -> a) -> (Struct a -> a -> Struct a) -> Lens (Struct a) a
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Struct a -> a
forall srcAnnot. Struct srcAnnot -> srcAnnot
structSrcAnnot (\Struct a
s a
a -> Struct a
s { structSrcAnnot = a })

instance HasDocstring (Struct a) where
    docstring :: Lens (Struct a) (Maybe Text)
docstring = (Struct a -> Maybe Text)
-> (Struct a -> Maybe Text -> Struct a)
-> Lens (Struct a) (Maybe Text)
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Struct a -> Maybe Text
forall srcAnnot. Struct srcAnnot -> Maybe Text
structDocstring (\Struct a
s Maybe Text
a -> Struct a
s { structDocstring = a })

instance HasAnnotations (Struct a) where
    annotations :: Lens (Struct a) [TypeAnnotation]
annotations = (Struct a -> [TypeAnnotation])
-> (Struct a -> [TypeAnnotation] -> Struct a)
-> Lens (Struct a) [TypeAnnotation]
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Struct a -> [TypeAnnotation]
forall srcAnnot. Struct srcAnnot -> [TypeAnnotation]
structAnnotations (\Struct a
s [TypeAnnotation]
a -> Struct a
s { structAnnotations = a })

-- | A union of other types.
type Union = Struct
{-# DEPRECATED Union "The type has been consolidated into Struct." #-}

unionName :: Union a -> Text
unionName :: forall srcAnnot. Struct srcAnnot -> Text
unionName = Struct a -> Text
forall srcAnnot. Struct srcAnnot -> Text
structName
{-# DEPRECATED unionName "Use structName." #-}

unionFields :: Union a -> [Field a]
unionFields :: forall srcAnnot. Struct srcAnnot -> [Field srcAnnot]
unionFields = Struct a -> [Field a]
forall srcAnnot. Struct srcAnnot -> [Field srcAnnot]
structFields
{-# DEPRECATED unionFields "Use structFields." #-}

unionAnnotations :: Union a -> [TypeAnnotation]
unionAnnotations :: forall srcAnnot. Struct srcAnnot -> [TypeAnnotation]
unionAnnotations = Struct a -> [TypeAnnotation]
forall srcAnnot. Struct srcAnnot -> [TypeAnnotation]
structAnnotations
{-# DEPRECATED unionAnnotations "Use structAnnotations." #-}

unionDocstring :: Union a -> Docstring
unionDocstring :: forall srcAnnot. Struct srcAnnot -> Maybe Text
unionDocstring = Struct a -> Maybe Text
forall srcAnnot. Struct srcAnnot -> Maybe Text
structDocstring
{-# DEPRECATED unionDocstring "Use structDocstring." #-}

unionSrcAnnot :: Union a -> a
unionSrcAnnot :: forall srcAnnot. Struct srcAnnot -> srcAnnot
unionSrcAnnot = Struct a -> a
forall srcAnnot. Struct srcAnnot -> srcAnnot
structSrcAnnot
{-# DEPRECATED unionSrcAnnot "Use structSrcAnnot." #-}

-- | Exception types.
type Exception = Struct
{-# DEPRECATED Exception "The type has been consolidated into Struct." #-}

exceptionName :: Exception a -> Text
exceptionName :: forall srcAnnot. Struct srcAnnot -> Text
exceptionName = Struct a -> Text
forall srcAnnot. Struct srcAnnot -> Text
structName
{-# DEPRECATED exceptionName "Use structName." #-}

exceptionFields :: Exception a -> [Field a]
exceptionFields :: forall srcAnnot. Struct srcAnnot -> [Field srcAnnot]
exceptionFields = Struct a -> [Field a]
forall srcAnnot. Struct srcAnnot -> [Field srcAnnot]
structFields
{-# DEPRECATED exceptionFields "Use structFields." #-}

exceptionAnnotations :: Exception a -> [TypeAnnotation]
exceptionAnnotations :: forall srcAnnot. Struct srcAnnot -> [TypeAnnotation]
exceptionAnnotations = Struct a -> [TypeAnnotation]
forall srcAnnot. Struct srcAnnot -> [TypeAnnotation]
structAnnotations
{-# DEPRECATED exceptionAnnotations "Use structAnnotations." #-}

exceptionDocstring :: Exception a -> Docstring
exceptionDocstring :: forall srcAnnot. Struct srcAnnot -> Maybe Text
exceptionDocstring = Struct a -> Maybe Text
forall srcAnnot. Struct srcAnnot -> Maybe Text
structDocstring
{-# DEPRECATED exceptionDocstring "Use structDocstring." #-}

exceptionSrcAnnot :: Exception a -> a
exceptionSrcAnnot :: forall srcAnnot. Struct srcAnnot -> srcAnnot
exceptionSrcAnnot = Struct a -> a
forall srcAnnot. Struct srcAnnot -> srcAnnot
structSrcAnnot
{-# DEPRECATED exceptionSrcAnnot "Use structSrcAnnot." #-}

-- | An string-only enum. These are a deprecated feature of Thrift and
-- shouldn't be used.
data Senum srcAnnot = Senum
    { forall srcAnnot. Senum srcAnnot -> Text
senumName        :: Text
    , forall srcAnnot. Senum srcAnnot -> [Text]
senumValues      :: [Text]
    , forall srcAnnot. Senum srcAnnot -> [TypeAnnotation]
senumAnnotations :: [TypeAnnotation]
    -- ^ Annotations added to the senum.
    , forall srcAnnot. Senum srcAnnot -> Maybe Text
senumDocstring   :: Docstring
    -- ^ Documentation.
    , forall srcAnnot. Senum srcAnnot -> srcAnnot
senumSrcAnnot    :: srcAnnot
    }
  deriving (Int -> Senum srcAnnot -> ShowS
[Senum srcAnnot] -> ShowS
Senum srcAnnot -> String
(Int -> Senum srcAnnot -> ShowS)
-> (Senum srcAnnot -> String)
-> ([Senum srcAnnot] -> ShowS)
-> Show (Senum srcAnnot)
forall srcAnnot. Show srcAnnot => Int -> Senum srcAnnot -> ShowS
forall srcAnnot. Show srcAnnot => [Senum srcAnnot] -> ShowS
forall srcAnnot. Show srcAnnot => Senum srcAnnot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall srcAnnot. Show srcAnnot => Int -> Senum srcAnnot -> ShowS
showsPrec :: Int -> Senum srcAnnot -> ShowS
$cshow :: forall srcAnnot. Show srcAnnot => Senum srcAnnot -> String
show :: Senum srcAnnot -> String
$cshowList :: forall srcAnnot. Show srcAnnot => [Senum srcAnnot] -> ShowS
showList :: [Senum srcAnnot] -> ShowS
Show, Eq (Senum srcAnnot)
Eq (Senum srcAnnot) =>
(Senum srcAnnot -> Senum srcAnnot -> Ordering)
-> (Senum srcAnnot -> Senum srcAnnot -> Bool)
-> (Senum srcAnnot -> Senum srcAnnot -> Bool)
-> (Senum srcAnnot -> Senum srcAnnot -> Bool)
-> (Senum srcAnnot -> Senum srcAnnot -> Bool)
-> (Senum srcAnnot -> Senum srcAnnot -> Senum srcAnnot)
-> (Senum srcAnnot -> Senum srcAnnot -> Senum srcAnnot)
-> Ord (Senum srcAnnot)
Senum srcAnnot -> Senum srcAnnot -> Bool
Senum srcAnnot -> Senum srcAnnot -> Ordering
Senum srcAnnot -> Senum srcAnnot -> Senum srcAnnot
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 srcAnnot. Ord srcAnnot => Eq (Senum srcAnnot)
forall srcAnnot.
Ord srcAnnot =>
Senum srcAnnot -> Senum srcAnnot -> Bool
forall srcAnnot.
Ord srcAnnot =>
Senum srcAnnot -> Senum srcAnnot -> Ordering
forall srcAnnot.
Ord srcAnnot =>
Senum srcAnnot -> Senum srcAnnot -> Senum srcAnnot
$ccompare :: forall srcAnnot.
Ord srcAnnot =>
Senum srcAnnot -> Senum srcAnnot -> Ordering
compare :: Senum srcAnnot -> Senum srcAnnot -> Ordering
$c< :: forall srcAnnot.
Ord srcAnnot =>
Senum srcAnnot -> Senum srcAnnot -> Bool
< :: Senum srcAnnot -> Senum srcAnnot -> Bool
$c<= :: forall srcAnnot.
Ord srcAnnot =>
Senum srcAnnot -> Senum srcAnnot -> Bool
<= :: Senum srcAnnot -> Senum srcAnnot -> Bool
$c> :: forall srcAnnot.
Ord srcAnnot =>
Senum srcAnnot -> Senum srcAnnot -> Bool
> :: Senum srcAnnot -> Senum srcAnnot -> Bool
$c>= :: forall srcAnnot.
Ord srcAnnot =>
Senum srcAnnot -> Senum srcAnnot -> Bool
>= :: Senum srcAnnot -> Senum srcAnnot -> Bool
$cmax :: forall srcAnnot.
Ord srcAnnot =>
Senum srcAnnot -> Senum srcAnnot -> Senum srcAnnot
max :: Senum srcAnnot -> Senum srcAnnot -> Senum srcAnnot
$cmin :: forall srcAnnot.
Ord srcAnnot =>
Senum srcAnnot -> Senum srcAnnot -> Senum srcAnnot
min :: Senum srcAnnot -> Senum srcAnnot -> Senum srcAnnot
Ord, Senum srcAnnot -> Senum srcAnnot -> Bool
(Senum srcAnnot -> Senum srcAnnot -> Bool)
-> (Senum srcAnnot -> Senum srcAnnot -> Bool)
-> Eq (Senum srcAnnot)
forall srcAnnot.
Eq srcAnnot =>
Senum srcAnnot -> Senum srcAnnot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall srcAnnot.
Eq srcAnnot =>
Senum srcAnnot -> Senum srcAnnot -> Bool
== :: Senum srcAnnot -> Senum srcAnnot -> Bool
$c/= :: forall srcAnnot.
Eq srcAnnot =>
Senum srcAnnot -> Senum srcAnnot -> Bool
/= :: Senum srcAnnot -> Senum srcAnnot -> Bool
Eq, Typeable (Senum srcAnnot)
Typeable (Senum srcAnnot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Senum srcAnnot -> c (Senum srcAnnot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Senum srcAnnot))
-> (Senum srcAnnot -> Constr)
-> (Senum srcAnnot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Senum srcAnnot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Senum srcAnnot)))
-> ((forall b. Data b => b -> b)
    -> Senum srcAnnot -> Senum srcAnnot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Senum srcAnnot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Senum srcAnnot -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> Senum srcAnnot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Senum srcAnnot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> Senum srcAnnot -> m (Senum srcAnnot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Senum srcAnnot -> m (Senum srcAnnot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Senum srcAnnot -> m (Senum srcAnnot))
-> Data (Senum srcAnnot)
Senum srcAnnot -> Constr
Senum srcAnnot -> DataType
(forall b. Data b => b -> b) -> Senum srcAnnot -> Senum srcAnnot
forall srcAnnot. Data srcAnnot => Typeable (Senum srcAnnot)
forall srcAnnot. Data srcAnnot => Senum srcAnnot -> Constr
forall srcAnnot. Data srcAnnot => Senum srcAnnot -> DataType
forall srcAnnot.
Data srcAnnot =>
(forall b. Data b => b -> b) -> Senum srcAnnot -> Senum srcAnnot
forall srcAnnot u.
Data srcAnnot =>
Int -> (forall d. Data d => d -> u) -> Senum srcAnnot -> u
forall srcAnnot u.
Data srcAnnot =>
(forall d. Data d => d -> u) -> Senum srcAnnot -> [u]
forall srcAnnot r r'.
Data srcAnnot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Senum srcAnnot -> r
forall srcAnnot r r'.
Data srcAnnot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Senum srcAnnot -> r
forall srcAnnot (m :: * -> *).
(Data srcAnnot, Monad m) =>
(forall d. Data d => d -> m d)
-> Senum srcAnnot -> m (Senum srcAnnot)
forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Senum srcAnnot -> m (Senum srcAnnot)
forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Senum srcAnnot)
forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Senum srcAnnot -> c (Senum srcAnnot)
forall srcAnnot (t :: * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Senum srcAnnot))
forall srcAnnot (t :: * -> * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Senum srcAnnot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> Senum srcAnnot -> u
forall u. (forall d. Data d => d -> u) -> Senum srcAnnot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Senum srcAnnot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Senum srcAnnot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Senum srcAnnot -> m (Senum srcAnnot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Senum srcAnnot -> m (Senum srcAnnot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Senum srcAnnot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Senum srcAnnot -> c (Senum srcAnnot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Senum srcAnnot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Senum srcAnnot))
$cgfoldl :: forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Senum srcAnnot -> c (Senum srcAnnot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Senum srcAnnot -> c (Senum srcAnnot)
$cgunfold :: forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Senum srcAnnot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Senum srcAnnot)
$ctoConstr :: forall srcAnnot. Data srcAnnot => Senum srcAnnot -> Constr
toConstr :: Senum srcAnnot -> Constr
$cdataTypeOf :: forall srcAnnot. Data srcAnnot => Senum srcAnnot -> DataType
dataTypeOf :: Senum srcAnnot -> DataType
$cdataCast1 :: forall srcAnnot (t :: * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Senum srcAnnot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Senum srcAnnot))
$cdataCast2 :: forall srcAnnot (t :: * -> * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Senum srcAnnot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Senum srcAnnot))
$cgmapT :: forall srcAnnot.
Data srcAnnot =>
(forall b. Data b => b -> b) -> Senum srcAnnot -> Senum srcAnnot
gmapT :: (forall b. Data b => b -> b) -> Senum srcAnnot -> Senum srcAnnot
$cgmapQl :: forall srcAnnot r r'.
Data srcAnnot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Senum srcAnnot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Senum srcAnnot -> r
$cgmapQr :: forall srcAnnot r r'.
Data srcAnnot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Senum srcAnnot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Senum srcAnnot -> r
$cgmapQ :: forall srcAnnot u.
Data srcAnnot =>
(forall d. Data d => d -> u) -> Senum srcAnnot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Senum srcAnnot -> [u]
$cgmapQi :: forall srcAnnot u.
Data srcAnnot =>
Int -> (forall d. Data d => d -> u) -> Senum srcAnnot -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> Senum srcAnnot -> u
$cgmapM :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, Monad m) =>
(forall d. Data d => d -> m d)
-> Senum srcAnnot -> m (Senum srcAnnot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Senum srcAnnot -> m (Senum srcAnnot)
$cgmapMp :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Senum srcAnnot -> m (Senum srcAnnot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Senum srcAnnot -> m (Senum srcAnnot)
$cgmapMo :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Senum srcAnnot -> m (Senum srcAnnot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Senum srcAnnot -> m (Senum srcAnnot)
Data, Typeable, (forall x. Senum srcAnnot -> Rep (Senum srcAnnot) x)
-> (forall x. Rep (Senum srcAnnot) x -> Senum srcAnnot)
-> Generic (Senum srcAnnot)
forall x. Rep (Senum srcAnnot) x -> Senum srcAnnot
forall x. Senum srcAnnot -> Rep (Senum srcAnnot) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall srcAnnot x. Rep (Senum srcAnnot) x -> Senum srcAnnot
forall srcAnnot x. Senum srcAnnot -> Rep (Senum srcAnnot) x
$cfrom :: forall srcAnnot x. Senum srcAnnot -> Rep (Senum srcAnnot) x
from :: forall x. Senum srcAnnot -> Rep (Senum srcAnnot) x
$cto :: forall srcAnnot x. Rep (Senum srcAnnot) x -> Senum srcAnnot
to :: forall x. Rep (Senum srcAnnot) x -> Senum srcAnnot
Generic, (forall a b. (a -> b) -> Senum a -> Senum b)
-> (forall a b. a -> Senum b -> Senum a) -> Functor Senum
forall a b. a -> Senum b -> Senum a
forall a b. (a -> b) -> Senum a -> Senum b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Senum a -> Senum b
fmap :: forall a b. (a -> b) -> Senum a -> Senum b
$c<$ :: forall a b. a -> Senum b -> Senum a
<$ :: forall a b. a -> Senum b -> Senum a
Functor)

instance HasValues (Senum a) [Text] where
    values :: Lens (Senum a) [Text]
values = (Senum a -> [Text])
-> (Senum a -> [Text] -> Senum a) -> Lens (Senum a) [Text]
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Senum a -> [Text]
forall srcAnnot. Senum srcAnnot -> [Text]
senumValues (\Senum a
s [Text]
a -> Senum a
s { senumValues = a })

instance HasName (Senum a) where
    name :: Lens (Senum a) Text
name = (Senum a -> Text)
-> (Senum a -> Text -> Senum a) -> Lens (Senum a) Text
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Senum a -> Text
forall srcAnnot. Senum srcAnnot -> Text
senumName (\Senum a
s Text
a -> Senum a
s { senumName = a })

instance HasSrcAnnot Senum where
    srcAnnot :: forall a. Lens (Senum a) a
srcAnnot = (Senum a -> a) -> (Senum a -> a -> Senum a) -> Lens (Senum a) a
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Senum a -> a
forall srcAnnot. Senum srcAnnot -> srcAnnot
senumSrcAnnot (\Senum a
s a
a -> Senum a
s { senumSrcAnnot = a })

instance HasDocstring (Senum a) where
    docstring :: Lens (Senum a) (Maybe Text)
docstring = (Senum a -> Maybe Text)
-> (Senum a -> Maybe Text -> Senum a)
-> Lens (Senum a) (Maybe Text)
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Senum a -> Maybe Text
forall srcAnnot. Senum srcAnnot -> Maybe Text
senumDocstring (\Senum a
s Maybe Text
a -> Senum a
s { senumDocstring = a })

instance HasAnnotations (Senum a) where
    annotations :: Lens (Senum a) [TypeAnnotation]
annotations = (Senum a -> [TypeAnnotation])
-> (Senum a -> [TypeAnnotation] -> Senum a)
-> Lens (Senum a) [TypeAnnotation]
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Senum a -> [TypeAnnotation]
forall srcAnnot. Senum srcAnnot -> [TypeAnnotation]
senumAnnotations (\Senum a
s [TypeAnnotation]
a -> Senum a
s { senumAnnotations = a })

-- | Defines the various types that can be declared in Thrift.
data Type srcAnnot
    = -- | @typedef@
      TypedefType (Typedef srcAnnot)
    | -- | @enum@
      EnumType (Enum srcAnnot)
    | -- | @struct@/@union@/@exception@
      StructType (Struct srcAnnot)
    | -- | @senum@
      SenumType (Senum srcAnnot)
  deriving (Int -> Type srcAnnot -> ShowS
[Type srcAnnot] -> ShowS
Type srcAnnot -> String
(Int -> Type srcAnnot -> ShowS)
-> (Type srcAnnot -> String)
-> ([Type srcAnnot] -> ShowS)
-> Show (Type srcAnnot)
forall srcAnnot. Show srcAnnot => Int -> Type srcAnnot -> ShowS
forall srcAnnot. Show srcAnnot => [Type srcAnnot] -> ShowS
forall srcAnnot. Show srcAnnot => Type srcAnnot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall srcAnnot. Show srcAnnot => Int -> Type srcAnnot -> ShowS
showsPrec :: Int -> Type srcAnnot -> ShowS
$cshow :: forall srcAnnot. Show srcAnnot => Type srcAnnot -> String
show :: Type srcAnnot -> String
$cshowList :: forall srcAnnot. Show srcAnnot => [Type srcAnnot] -> ShowS
showList :: [Type srcAnnot] -> ShowS
Show, Eq (Type srcAnnot)
Eq (Type srcAnnot) =>
(Type srcAnnot -> Type srcAnnot -> Ordering)
-> (Type srcAnnot -> Type srcAnnot -> Bool)
-> (Type srcAnnot -> Type srcAnnot -> Bool)
-> (Type srcAnnot -> Type srcAnnot -> Bool)
-> (Type srcAnnot -> Type srcAnnot -> Bool)
-> (Type srcAnnot -> Type srcAnnot -> Type srcAnnot)
-> (Type srcAnnot -> Type srcAnnot -> Type srcAnnot)
-> Ord (Type srcAnnot)
Type srcAnnot -> Type srcAnnot -> Bool
Type srcAnnot -> Type srcAnnot -> Ordering
Type srcAnnot -> Type srcAnnot -> Type srcAnnot
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 srcAnnot. Ord srcAnnot => Eq (Type srcAnnot)
forall srcAnnot.
Ord srcAnnot =>
Type srcAnnot -> Type srcAnnot -> Bool
forall srcAnnot.
Ord srcAnnot =>
Type srcAnnot -> Type srcAnnot -> Ordering
forall srcAnnot.
Ord srcAnnot =>
Type srcAnnot -> Type srcAnnot -> Type srcAnnot
$ccompare :: forall srcAnnot.
Ord srcAnnot =>
Type srcAnnot -> Type srcAnnot -> Ordering
compare :: Type srcAnnot -> Type srcAnnot -> Ordering
$c< :: forall srcAnnot.
Ord srcAnnot =>
Type srcAnnot -> Type srcAnnot -> Bool
< :: Type srcAnnot -> Type srcAnnot -> Bool
$c<= :: forall srcAnnot.
Ord srcAnnot =>
Type srcAnnot -> Type srcAnnot -> Bool
<= :: Type srcAnnot -> Type srcAnnot -> Bool
$c> :: forall srcAnnot.
Ord srcAnnot =>
Type srcAnnot -> Type srcAnnot -> Bool
> :: Type srcAnnot -> Type srcAnnot -> Bool
$c>= :: forall srcAnnot.
Ord srcAnnot =>
Type srcAnnot -> Type srcAnnot -> Bool
>= :: Type srcAnnot -> Type srcAnnot -> Bool
$cmax :: forall srcAnnot.
Ord srcAnnot =>
Type srcAnnot -> Type srcAnnot -> Type srcAnnot
max :: Type srcAnnot -> Type srcAnnot -> Type srcAnnot
$cmin :: forall srcAnnot.
Ord srcAnnot =>
Type srcAnnot -> Type srcAnnot -> Type srcAnnot
min :: Type srcAnnot -> Type srcAnnot -> Type srcAnnot
Ord, Type srcAnnot -> Type srcAnnot -> Bool
(Type srcAnnot -> Type srcAnnot -> Bool)
-> (Type srcAnnot -> Type srcAnnot -> Bool) -> Eq (Type srcAnnot)
forall srcAnnot.
Eq srcAnnot =>
Type srcAnnot -> Type srcAnnot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall srcAnnot.
Eq srcAnnot =>
Type srcAnnot -> Type srcAnnot -> Bool
== :: Type srcAnnot -> Type srcAnnot -> Bool
$c/= :: forall srcAnnot.
Eq srcAnnot =>
Type srcAnnot -> Type srcAnnot -> Bool
/= :: Type srcAnnot -> Type srcAnnot -> Bool
Eq, Typeable (Type srcAnnot)
Typeable (Type srcAnnot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Type srcAnnot -> c (Type srcAnnot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Type srcAnnot))
-> (Type srcAnnot -> Constr)
-> (Type srcAnnot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Type srcAnnot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Type srcAnnot)))
-> ((forall b. Data b => b -> b) -> Type srcAnnot -> Type srcAnnot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Type srcAnnot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Type srcAnnot -> r)
-> (forall u. (forall d. Data d => d -> u) -> Type srcAnnot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Type srcAnnot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> Type srcAnnot -> m (Type srcAnnot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Type srcAnnot -> m (Type srcAnnot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Type srcAnnot -> m (Type srcAnnot))
-> Data (Type srcAnnot)
Type srcAnnot -> Constr
Type srcAnnot -> DataType
(forall b. Data b => b -> b) -> Type srcAnnot -> Type srcAnnot
forall srcAnnot. Data srcAnnot => Typeable (Type srcAnnot)
forall srcAnnot. Data srcAnnot => Type srcAnnot -> Constr
forall srcAnnot. Data srcAnnot => Type srcAnnot -> DataType
forall srcAnnot.
Data srcAnnot =>
(forall b. Data b => b -> b) -> Type srcAnnot -> Type srcAnnot
forall srcAnnot u.
Data srcAnnot =>
Int -> (forall d. Data d => d -> u) -> Type srcAnnot -> u
forall srcAnnot u.
Data srcAnnot =>
(forall d. Data d => d -> u) -> Type srcAnnot -> [u]
forall srcAnnot r r'.
Data srcAnnot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Type srcAnnot -> r
forall srcAnnot r r'.
Data srcAnnot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Type srcAnnot -> r
forall srcAnnot (m :: * -> *).
(Data srcAnnot, Monad m) =>
(forall d. Data d => d -> m d)
-> Type srcAnnot -> m (Type srcAnnot)
forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Type srcAnnot -> m (Type srcAnnot)
forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Type srcAnnot)
forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Type srcAnnot -> c (Type srcAnnot)
forall srcAnnot (t :: * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Type srcAnnot))
forall srcAnnot (t :: * -> * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Type srcAnnot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Type srcAnnot -> u
forall u. (forall d. Data d => d -> u) -> Type srcAnnot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Type srcAnnot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Type srcAnnot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Type srcAnnot -> m (Type srcAnnot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Type srcAnnot -> m (Type srcAnnot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Type srcAnnot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Type srcAnnot -> c (Type srcAnnot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Type srcAnnot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Type srcAnnot))
$cgfoldl :: forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Type srcAnnot -> c (Type srcAnnot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Type srcAnnot -> c (Type srcAnnot)
$cgunfold :: forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Type srcAnnot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Type srcAnnot)
$ctoConstr :: forall srcAnnot. Data srcAnnot => Type srcAnnot -> Constr
toConstr :: Type srcAnnot -> Constr
$cdataTypeOf :: forall srcAnnot. Data srcAnnot => Type srcAnnot -> DataType
dataTypeOf :: Type srcAnnot -> DataType
$cdataCast1 :: forall srcAnnot (t :: * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Type srcAnnot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Type srcAnnot))
$cdataCast2 :: forall srcAnnot (t :: * -> * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Type srcAnnot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Type srcAnnot))
$cgmapT :: forall srcAnnot.
Data srcAnnot =>
(forall b. Data b => b -> b) -> Type srcAnnot -> Type srcAnnot
gmapT :: (forall b. Data b => b -> b) -> Type srcAnnot -> Type srcAnnot
$cgmapQl :: forall srcAnnot r r'.
Data srcAnnot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Type srcAnnot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Type srcAnnot -> r
$cgmapQr :: forall srcAnnot r r'.
Data srcAnnot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Type srcAnnot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Type srcAnnot -> r
$cgmapQ :: forall srcAnnot u.
Data srcAnnot =>
(forall d. Data d => d -> u) -> Type srcAnnot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Type srcAnnot -> [u]
$cgmapQi :: forall srcAnnot u.
Data srcAnnot =>
Int -> (forall d. Data d => d -> u) -> Type srcAnnot -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Type srcAnnot -> u
$cgmapM :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, Monad m) =>
(forall d. Data d => d -> m d)
-> Type srcAnnot -> m (Type srcAnnot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Type srcAnnot -> m (Type srcAnnot)
$cgmapMp :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Type srcAnnot -> m (Type srcAnnot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Type srcAnnot -> m (Type srcAnnot)
$cgmapMo :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Type srcAnnot -> m (Type srcAnnot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Type srcAnnot -> m (Type srcAnnot)
Data, Typeable, (forall x. Type srcAnnot -> Rep (Type srcAnnot) x)
-> (forall x. Rep (Type srcAnnot) x -> Type srcAnnot)
-> Generic (Type srcAnnot)
forall x. Rep (Type srcAnnot) x -> Type srcAnnot
forall x. Type srcAnnot -> Rep (Type srcAnnot) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall srcAnnot x. Rep (Type srcAnnot) x -> Type srcAnnot
forall srcAnnot x. Type srcAnnot -> Rep (Type srcAnnot) x
$cfrom :: forall srcAnnot x. Type srcAnnot -> Rep (Type srcAnnot) x
from :: forall x. Type srcAnnot -> Rep (Type srcAnnot) x
$cto :: forall srcAnnot x. Rep (Type srcAnnot) x -> Type srcAnnot
to :: forall x. Rep (Type srcAnnot) x -> Type srcAnnot
Generic, (forall a b. (a -> b) -> Type a -> Type b)
-> (forall a b. a -> Type b -> Type a) -> Functor Type
forall a b. a -> Type b -> Type a
forall a b. (a -> b) -> Type a -> Type b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Type a -> Type b
fmap :: forall a b. (a -> b) -> Type a -> Type b
$c<$ :: forall a b. a -> Type b -> Type a
<$ :: forall a b. a -> Type b -> Type a
Functor)

instance HasName (Type a) where
    name :: Lens (Type a) Text
name = (Type a -> Text)
-> (Type a -> Text -> Type a) -> Lens (Type a) Text
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Type a -> Text
forall {srcAnnot}. Type srcAnnot -> Text
getter Type a -> Text -> Type a
forall {srcAnnot}. Type srcAnnot -> Text -> Type srcAnnot
setter
      where
        getter :: Type srcAnnot -> Text
getter (TypedefType   Typedef srcAnnot
t) = Lens (Typedef srcAnnot) Text -> Typedef srcAnnot -> Text
forall s a. Lens s a -> s -> a
view (Text -> f Text) -> Typedef srcAnnot -> f (Typedef srcAnnot)
forall t. HasName t => Lens t Text
Lens (Typedef srcAnnot) Text
name Typedef srcAnnot
t
        getter (EnumType      Enum srcAnnot
t) = Lens (Enum srcAnnot) Text -> Enum srcAnnot -> Text
forall s a. Lens s a -> s -> a
view (Text -> f Text) -> Enum srcAnnot -> f (Enum srcAnnot)
forall t. HasName t => Lens t Text
Lens (Enum srcAnnot) Text
name Enum srcAnnot
t
        getter (StructType    Struct srcAnnot
t) = Lens (Struct srcAnnot) Text -> Struct srcAnnot -> Text
forall s a. Lens s a -> s -> a
view (Text -> f Text) -> Struct srcAnnot -> f (Struct srcAnnot)
forall t. HasName t => Lens t Text
Lens (Struct srcAnnot) Text
name Struct srcAnnot
t
        getter (SenumType     Senum srcAnnot
t) = Lens (Senum srcAnnot) Text -> Senum srcAnnot -> Text
forall s a. Lens s a -> s -> a
view (Text -> f Text) -> Senum srcAnnot -> f (Senum srcAnnot)
forall t. HasName t => Lens t Text
Lens (Senum srcAnnot) Text
name Senum srcAnnot
t

        setter :: Type srcAnnot -> Text -> Type srcAnnot
setter (TypedefType   Typedef srcAnnot
t) Text
n = Typedef srcAnnot -> Type srcAnnot
forall srcAnnot. Typedef srcAnnot -> Type srcAnnot
TypedefType   (Typedef srcAnnot -> Type srcAnnot)
-> Typedef srcAnnot -> Type srcAnnot
forall a b. (a -> b) -> a -> b
$ Lens (Typedef srcAnnot) Text
-> Text -> Typedef srcAnnot -> Typedef srcAnnot
forall s a. Lens s a -> a -> s -> s
set (Text -> f Text) -> Typedef srcAnnot -> f (Typedef srcAnnot)
forall t. HasName t => Lens t Text
Lens (Typedef srcAnnot) Text
name Text
n Typedef srcAnnot
t
        setter (EnumType      Enum srcAnnot
t) Text
n = Enum srcAnnot -> Type srcAnnot
forall srcAnnot. Enum srcAnnot -> Type srcAnnot
EnumType      (Enum srcAnnot -> Type srcAnnot) -> Enum srcAnnot -> Type srcAnnot
forall a b. (a -> b) -> a -> b
$ Lens (Enum srcAnnot) Text -> Text -> Enum srcAnnot -> Enum srcAnnot
forall s a. Lens s a -> a -> s -> s
set (Text -> f Text) -> Enum srcAnnot -> f (Enum srcAnnot)
forall t. HasName t => Lens t Text
Lens (Enum srcAnnot) Text
name Text
n Enum srcAnnot
t
        setter (StructType    Struct srcAnnot
t) Text
n = Struct srcAnnot -> Type srcAnnot
forall srcAnnot. Struct srcAnnot -> Type srcAnnot
StructType    (Struct srcAnnot -> Type srcAnnot)
-> Struct srcAnnot -> Type srcAnnot
forall a b. (a -> b) -> a -> b
$ Lens (Struct srcAnnot) Text
-> Text -> Struct srcAnnot -> Struct srcAnnot
forall s a. Lens s a -> a -> s -> s
set (Text -> f Text) -> Struct srcAnnot -> f (Struct srcAnnot)
forall t. HasName t => Lens t Text
Lens (Struct srcAnnot) Text
name Text
n Struct srcAnnot
t
        setter (SenumType     Senum srcAnnot
t) Text
n = Senum srcAnnot -> Type srcAnnot
forall srcAnnot. Senum srcAnnot -> Type srcAnnot
SenumType     (Senum srcAnnot -> Type srcAnnot)
-> Senum srcAnnot -> Type srcAnnot
forall a b. (a -> b) -> a -> b
$ Lens (Senum srcAnnot) Text
-> Text -> Senum srcAnnot -> Senum srcAnnot
forall s a. Lens s a -> a -> s -> s
set (Text -> f Text) -> Senum srcAnnot -> f (Senum srcAnnot)
forall t. HasName t => Lens t Text
Lens (Senum srcAnnot) Text
name Text
n Senum srcAnnot
t

instance HasSrcAnnot Type where
    srcAnnot :: forall a. Lens (Type a) a
srcAnnot = (Type a -> a) -> (Type a -> a -> Type a) -> Lens (Type a) a
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Type a -> a
forall {srcAnnot}. Type srcAnnot -> srcAnnot
getter Type a -> a -> Type a
forall {srcAnnot}. Type srcAnnot -> srcAnnot -> Type srcAnnot
setter
      where
        getter :: Type srcAnnot -> srcAnnot
getter (TypedefType   Typedef srcAnnot
t) = Lens (Typedef srcAnnot) srcAnnot -> Typedef srcAnnot -> srcAnnot
forall s a. Lens s a -> s -> a
view (srcAnnot -> f srcAnnot)
-> Typedef srcAnnot -> f (Typedef srcAnnot)
forall a. Lens (Typedef a) a
Lens (Typedef srcAnnot) srcAnnot
forall (t :: * -> *) a. HasSrcAnnot t => Lens (t a) a
srcAnnot Typedef srcAnnot
t
        getter (EnumType      Enum srcAnnot
t) = Lens (Enum srcAnnot) srcAnnot -> Enum srcAnnot -> srcAnnot
forall s a. Lens s a -> s -> a
view (srcAnnot -> f srcAnnot) -> Enum srcAnnot -> f (Enum srcAnnot)
forall a. Lens (Enum a) a
Lens (Enum srcAnnot) srcAnnot
forall (t :: * -> *) a. HasSrcAnnot t => Lens (t a) a
srcAnnot Enum srcAnnot
t
        getter (StructType    Struct srcAnnot
t) = Lens (Struct srcAnnot) srcAnnot -> Struct srcAnnot -> srcAnnot
forall s a. Lens s a -> s -> a
view (srcAnnot -> f srcAnnot) -> Struct srcAnnot -> f (Struct srcAnnot)
forall a. Lens (Struct a) a
Lens (Struct srcAnnot) srcAnnot
forall (t :: * -> *) a. HasSrcAnnot t => Lens (t a) a
srcAnnot Struct srcAnnot
t
        getter (SenumType     Senum srcAnnot
t) = Lens (Senum srcAnnot) srcAnnot -> Senum srcAnnot -> srcAnnot
forall s a. Lens s a -> s -> a
view (srcAnnot -> f srcAnnot) -> Senum srcAnnot -> f (Senum srcAnnot)
forall a. Lens (Senum a) a
Lens (Senum srcAnnot) srcAnnot
forall (t :: * -> *) a. HasSrcAnnot t => Lens (t a) a
srcAnnot Senum srcAnnot
t

        setter :: Type srcAnnot -> srcAnnot -> Type srcAnnot
setter (TypedefType   Typedef srcAnnot
t) srcAnnot
a = Typedef srcAnnot -> Type srcAnnot
forall srcAnnot. Typedef srcAnnot -> Type srcAnnot
TypedefType   (Typedef srcAnnot -> Type srcAnnot)
-> Typedef srcAnnot -> Type srcAnnot
forall a b. (a -> b) -> a -> b
$ Lens (Typedef srcAnnot) srcAnnot
-> srcAnnot -> Typedef srcAnnot -> Typedef srcAnnot
forall s a. Lens s a -> a -> s -> s
set (srcAnnot -> f srcAnnot)
-> Typedef srcAnnot -> f (Typedef srcAnnot)
forall a. Lens (Typedef a) a
Lens (Typedef srcAnnot) srcAnnot
forall (t :: * -> *) a. HasSrcAnnot t => Lens (t a) a
srcAnnot srcAnnot
a Typedef srcAnnot
t
        setter (EnumType      Enum srcAnnot
t) srcAnnot
a = Enum srcAnnot -> Type srcAnnot
forall srcAnnot. Enum srcAnnot -> Type srcAnnot
EnumType      (Enum srcAnnot -> Type srcAnnot) -> Enum srcAnnot -> Type srcAnnot
forall a b. (a -> b) -> a -> b
$ Lens (Enum srcAnnot) srcAnnot
-> srcAnnot -> Enum srcAnnot -> Enum srcAnnot
forall s a. Lens s a -> a -> s -> s
set (srcAnnot -> f srcAnnot) -> Enum srcAnnot -> f (Enum srcAnnot)
forall a. Lens (Enum a) a
Lens (Enum srcAnnot) srcAnnot
forall (t :: * -> *) a. HasSrcAnnot t => Lens (t a) a
srcAnnot srcAnnot
a Enum srcAnnot
t
        setter (StructType    Struct srcAnnot
t) srcAnnot
a = Struct srcAnnot -> Type srcAnnot
forall srcAnnot. Struct srcAnnot -> Type srcAnnot
StructType    (Struct srcAnnot -> Type srcAnnot)
-> Struct srcAnnot -> Type srcAnnot
forall a b. (a -> b) -> a -> b
$ Lens (Struct srcAnnot) srcAnnot
-> srcAnnot -> Struct srcAnnot -> Struct srcAnnot
forall s a. Lens s a -> a -> s -> s
set (srcAnnot -> f srcAnnot) -> Struct srcAnnot -> f (Struct srcAnnot)
forall a. Lens (Struct a) a
Lens (Struct srcAnnot) srcAnnot
forall (t :: * -> *) a. HasSrcAnnot t => Lens (t a) a
srcAnnot srcAnnot
a Struct srcAnnot
t
        setter (SenumType     Senum srcAnnot
t) srcAnnot
a = Senum srcAnnot -> Type srcAnnot
forall srcAnnot. Senum srcAnnot -> Type srcAnnot
SenumType     (Senum srcAnnot -> Type srcAnnot)
-> Senum srcAnnot -> Type srcAnnot
forall a b. (a -> b) -> a -> b
$ Lens (Senum srcAnnot) srcAnnot
-> srcAnnot -> Senum srcAnnot -> Senum srcAnnot
forall s a. Lens s a -> a -> s -> s
set (srcAnnot -> f srcAnnot) -> Senum srcAnnot -> f (Senum srcAnnot)
forall a. Lens (Senum a) a
Lens (Senum srcAnnot) srcAnnot
forall (t :: * -> *) a. HasSrcAnnot t => Lens (t a) a
srcAnnot srcAnnot
a Senum srcAnnot
t

-- | A definition either consists of new constants, new types, or new
-- services.
data Definition srcAnnot
    = -- | A declared constant.
      ConstDefinition (Const srcAnnot)
    | -- | A custom type.
      TypeDefinition (Type srcAnnot)
    | -- | A service definition.
      ServiceDefinition (Service srcAnnot)
  deriving (Int -> Definition srcAnnot -> ShowS
[Definition srcAnnot] -> ShowS
Definition srcAnnot -> String
(Int -> Definition srcAnnot -> ShowS)
-> (Definition srcAnnot -> String)
-> ([Definition srcAnnot] -> ShowS)
-> Show (Definition srcAnnot)
forall srcAnnot.
Show srcAnnot =>
Int -> Definition srcAnnot -> ShowS
forall srcAnnot. Show srcAnnot => [Definition srcAnnot] -> ShowS
forall srcAnnot. Show srcAnnot => Definition srcAnnot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall srcAnnot.
Show srcAnnot =>
Int -> Definition srcAnnot -> ShowS
showsPrec :: Int -> Definition srcAnnot -> ShowS
$cshow :: forall srcAnnot. Show srcAnnot => Definition srcAnnot -> String
show :: Definition srcAnnot -> String
$cshowList :: forall srcAnnot. Show srcAnnot => [Definition srcAnnot] -> ShowS
showList :: [Definition srcAnnot] -> ShowS
Show, Eq (Definition srcAnnot)
Eq (Definition srcAnnot) =>
(Definition srcAnnot -> Definition srcAnnot -> Ordering)
-> (Definition srcAnnot -> Definition srcAnnot -> Bool)
-> (Definition srcAnnot -> Definition srcAnnot -> Bool)
-> (Definition srcAnnot -> Definition srcAnnot -> Bool)
-> (Definition srcAnnot -> Definition srcAnnot -> Bool)
-> (Definition srcAnnot
    -> Definition srcAnnot -> Definition srcAnnot)
-> (Definition srcAnnot
    -> Definition srcAnnot -> Definition srcAnnot)
-> Ord (Definition srcAnnot)
Definition srcAnnot -> Definition srcAnnot -> Bool
Definition srcAnnot -> Definition srcAnnot -> Ordering
Definition srcAnnot -> Definition srcAnnot -> Definition srcAnnot
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 srcAnnot. Ord srcAnnot => Eq (Definition srcAnnot)
forall srcAnnot.
Ord srcAnnot =>
Definition srcAnnot -> Definition srcAnnot -> Bool
forall srcAnnot.
Ord srcAnnot =>
Definition srcAnnot -> Definition srcAnnot -> Ordering
forall srcAnnot.
Ord srcAnnot =>
Definition srcAnnot -> Definition srcAnnot -> Definition srcAnnot
$ccompare :: forall srcAnnot.
Ord srcAnnot =>
Definition srcAnnot -> Definition srcAnnot -> Ordering
compare :: Definition srcAnnot -> Definition srcAnnot -> Ordering
$c< :: forall srcAnnot.
Ord srcAnnot =>
Definition srcAnnot -> Definition srcAnnot -> Bool
< :: Definition srcAnnot -> Definition srcAnnot -> Bool
$c<= :: forall srcAnnot.
Ord srcAnnot =>
Definition srcAnnot -> Definition srcAnnot -> Bool
<= :: Definition srcAnnot -> Definition srcAnnot -> Bool
$c> :: forall srcAnnot.
Ord srcAnnot =>
Definition srcAnnot -> Definition srcAnnot -> Bool
> :: Definition srcAnnot -> Definition srcAnnot -> Bool
$c>= :: forall srcAnnot.
Ord srcAnnot =>
Definition srcAnnot -> Definition srcAnnot -> Bool
>= :: Definition srcAnnot -> Definition srcAnnot -> Bool
$cmax :: forall srcAnnot.
Ord srcAnnot =>
Definition srcAnnot -> Definition srcAnnot -> Definition srcAnnot
max :: Definition srcAnnot -> Definition srcAnnot -> Definition srcAnnot
$cmin :: forall srcAnnot.
Ord srcAnnot =>
Definition srcAnnot -> Definition srcAnnot -> Definition srcAnnot
min :: Definition srcAnnot -> Definition srcAnnot -> Definition srcAnnot
Ord, Definition srcAnnot -> Definition srcAnnot -> Bool
(Definition srcAnnot -> Definition srcAnnot -> Bool)
-> (Definition srcAnnot -> Definition srcAnnot -> Bool)
-> Eq (Definition srcAnnot)
forall srcAnnot.
Eq srcAnnot =>
Definition srcAnnot -> Definition srcAnnot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall srcAnnot.
Eq srcAnnot =>
Definition srcAnnot -> Definition srcAnnot -> Bool
== :: Definition srcAnnot -> Definition srcAnnot -> Bool
$c/= :: forall srcAnnot.
Eq srcAnnot =>
Definition srcAnnot -> Definition srcAnnot -> Bool
/= :: Definition srcAnnot -> Definition srcAnnot -> Bool
Eq, Typeable (Definition srcAnnot)
Typeable (Definition srcAnnot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> Definition srcAnnot
 -> c (Definition srcAnnot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Definition srcAnnot))
-> (Definition srcAnnot -> Constr)
-> (Definition srcAnnot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Definition srcAnnot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Definition srcAnnot)))
-> ((forall b. Data b => b -> b)
    -> Definition srcAnnot -> Definition srcAnnot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Definition srcAnnot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Definition srcAnnot -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> Definition srcAnnot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Definition srcAnnot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> Definition srcAnnot -> m (Definition srcAnnot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Definition srcAnnot -> m (Definition srcAnnot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Definition srcAnnot -> m (Definition srcAnnot))
-> Data (Definition srcAnnot)
Definition srcAnnot -> Constr
Definition srcAnnot -> DataType
(forall b. Data b => b -> b)
-> Definition srcAnnot -> Definition srcAnnot
forall srcAnnot. Data srcAnnot => Typeable (Definition srcAnnot)
forall srcAnnot. Data srcAnnot => Definition srcAnnot -> Constr
forall srcAnnot. Data srcAnnot => Definition srcAnnot -> DataType
forall srcAnnot.
Data srcAnnot =>
(forall b. Data b => b -> b)
-> Definition srcAnnot -> Definition srcAnnot
forall srcAnnot u.
Data srcAnnot =>
Int -> (forall d. Data d => d -> u) -> Definition srcAnnot -> u
forall srcAnnot u.
Data srcAnnot =>
(forall d. Data d => d -> u) -> Definition srcAnnot -> [u]
forall srcAnnot r r'.
Data srcAnnot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Definition srcAnnot -> r
forall srcAnnot r r'.
Data srcAnnot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Definition srcAnnot -> r
forall srcAnnot (m :: * -> *).
(Data srcAnnot, Monad m) =>
(forall d. Data d => d -> m d)
-> Definition srcAnnot -> m (Definition srcAnnot)
forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Definition srcAnnot -> m (Definition srcAnnot)
forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Definition srcAnnot)
forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Definition srcAnnot
-> c (Definition srcAnnot)
forall srcAnnot (t :: * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Definition srcAnnot))
forall srcAnnot (t :: * -> * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Definition srcAnnot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> Definition srcAnnot -> u
forall u.
(forall d. Data d => d -> u) -> Definition srcAnnot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Definition srcAnnot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Definition srcAnnot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Definition srcAnnot -> m (Definition srcAnnot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Definition srcAnnot -> m (Definition srcAnnot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Definition srcAnnot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Definition srcAnnot
-> c (Definition srcAnnot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Definition srcAnnot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Definition srcAnnot))
$cgfoldl :: forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Definition srcAnnot
-> c (Definition srcAnnot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Definition srcAnnot
-> c (Definition srcAnnot)
$cgunfold :: forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Definition srcAnnot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Definition srcAnnot)
$ctoConstr :: forall srcAnnot. Data srcAnnot => Definition srcAnnot -> Constr
toConstr :: Definition srcAnnot -> Constr
$cdataTypeOf :: forall srcAnnot. Data srcAnnot => Definition srcAnnot -> DataType
dataTypeOf :: Definition srcAnnot -> DataType
$cdataCast1 :: forall srcAnnot (t :: * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Definition srcAnnot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Definition srcAnnot))
$cdataCast2 :: forall srcAnnot (t :: * -> * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Definition srcAnnot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Definition srcAnnot))
$cgmapT :: forall srcAnnot.
Data srcAnnot =>
(forall b. Data b => b -> b)
-> Definition srcAnnot -> Definition srcAnnot
gmapT :: (forall b. Data b => b -> b)
-> Definition srcAnnot -> Definition srcAnnot
$cgmapQl :: forall srcAnnot r r'.
Data srcAnnot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Definition srcAnnot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Definition srcAnnot -> r
$cgmapQr :: forall srcAnnot r r'.
Data srcAnnot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Definition srcAnnot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Definition srcAnnot -> r
$cgmapQ :: forall srcAnnot u.
Data srcAnnot =>
(forall d. Data d => d -> u) -> Definition srcAnnot -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> Definition srcAnnot -> [u]
$cgmapQi :: forall srcAnnot u.
Data srcAnnot =>
Int -> (forall d. Data d => d -> u) -> Definition srcAnnot -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> Definition srcAnnot -> u
$cgmapM :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, Monad m) =>
(forall d. Data d => d -> m d)
-> Definition srcAnnot -> m (Definition srcAnnot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Definition srcAnnot -> m (Definition srcAnnot)
$cgmapMp :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Definition srcAnnot -> m (Definition srcAnnot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Definition srcAnnot -> m (Definition srcAnnot)
$cgmapMo :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Definition srcAnnot -> m (Definition srcAnnot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Definition srcAnnot -> m (Definition srcAnnot)
Data, Typeable, (forall x. Definition srcAnnot -> Rep (Definition srcAnnot) x)
-> (forall x. Rep (Definition srcAnnot) x -> Definition srcAnnot)
-> Generic (Definition srcAnnot)
forall x. Rep (Definition srcAnnot) x -> Definition srcAnnot
forall x. Definition srcAnnot -> Rep (Definition srcAnnot) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall srcAnnot x.
Rep (Definition srcAnnot) x -> Definition srcAnnot
forall srcAnnot x.
Definition srcAnnot -> Rep (Definition srcAnnot) x
$cfrom :: forall srcAnnot x.
Definition srcAnnot -> Rep (Definition srcAnnot) x
from :: forall x. Definition srcAnnot -> Rep (Definition srcAnnot) x
$cto :: forall srcAnnot x.
Rep (Definition srcAnnot) x -> Definition srcAnnot
to :: forall x. Rep (Definition srcAnnot) x -> Definition srcAnnot
Generic, (forall a b. (a -> b) -> Definition a -> Definition b)
-> (forall a b. a -> Definition b -> Definition a)
-> Functor Definition
forall a b. a -> Definition b -> Definition a
forall a b. (a -> b) -> Definition a -> Definition b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Definition a -> Definition b
fmap :: forall a b. (a -> b) -> Definition a -> Definition b
$c<$ :: forall a b. a -> Definition b -> Definition a
<$ :: forall a b. a -> Definition b -> Definition a
Functor)

instance HasName (Definition a) where
    name :: Lens (Definition a) Text
name = (Definition a -> Text)
-> (Definition a -> Text -> Definition a)
-> Lens (Definition a) Text
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Definition a -> Text
forall {srcAnnot}. Definition srcAnnot -> Text
getter Definition a -> Text -> Definition a
forall {srcAnnot}.
Definition srcAnnot -> Text -> Definition srcAnnot
setter
      where
        getter :: Definition srcAnnot -> Text
getter (ConstDefinition   Const srcAnnot
d) = Lens (Const srcAnnot) Text -> Const srcAnnot -> Text
forall s a. Lens s a -> s -> a
view (Text -> f Text) -> Const srcAnnot -> f (Const srcAnnot)
forall t. HasName t => Lens t Text
Lens (Const srcAnnot) Text
name Const srcAnnot
d
        getter (TypeDefinition    Type srcAnnot
d) = Lens (Type srcAnnot) Text -> Type srcAnnot -> Text
forall s a. Lens s a -> s -> a
view (Text -> f Text) -> Type srcAnnot -> f (Type srcAnnot)
forall t. HasName t => Lens t Text
Lens (Type srcAnnot) Text
name Type srcAnnot
d
        getter (ServiceDefinition Service srcAnnot
d) = Lens (Service srcAnnot) Text -> Service srcAnnot -> Text
forall s a. Lens s a -> s -> a
view (Text -> f Text) -> Service srcAnnot -> f (Service srcAnnot)
forall t. HasName t => Lens t Text
Lens (Service srcAnnot) Text
name Service srcAnnot
d

        setter :: Definition srcAnnot -> Text -> Definition srcAnnot
setter (ConstDefinition   Const srcAnnot
d) Text
n = Const srcAnnot -> Definition srcAnnot
forall srcAnnot. Const srcAnnot -> Definition srcAnnot
ConstDefinition   (Const srcAnnot -> Definition srcAnnot)
-> Const srcAnnot -> Definition srcAnnot
forall a b. (a -> b) -> a -> b
$ Lens (Const srcAnnot) Text
-> Text -> Const srcAnnot -> Const srcAnnot
forall s a. Lens s a -> a -> s -> s
set (Text -> f Text) -> Const srcAnnot -> f (Const srcAnnot)
forall t. HasName t => Lens t Text
Lens (Const srcAnnot) Text
name Text
n Const srcAnnot
d
        setter (TypeDefinition    Type srcAnnot
d) Text
n = Type srcAnnot -> Definition srcAnnot
forall srcAnnot. Type srcAnnot -> Definition srcAnnot
TypeDefinition    (Type srcAnnot -> Definition srcAnnot)
-> Type srcAnnot -> Definition srcAnnot
forall a b. (a -> b) -> a -> b
$ Lens (Type srcAnnot) Text -> Text -> Type srcAnnot -> Type srcAnnot
forall s a. Lens s a -> a -> s -> s
set (Text -> f Text) -> Type srcAnnot -> f (Type srcAnnot)
forall t. HasName t => Lens t Text
Lens (Type srcAnnot) Text
name Text
n Type srcAnnot
d
        setter (ServiceDefinition Service srcAnnot
d) Text
n = Service srcAnnot -> Definition srcAnnot
forall srcAnnot. Service srcAnnot -> Definition srcAnnot
ServiceDefinition (Service srcAnnot -> Definition srcAnnot)
-> Service srcAnnot -> Definition srcAnnot
forall a b. (a -> b) -> a -> b
$ Lens (Service srcAnnot) Text
-> Text -> Service srcAnnot -> Service srcAnnot
forall s a. Lens s a -> a -> s -> s
set (Text -> f Text) -> Service srcAnnot -> f (Service srcAnnot)
forall t. HasName t => Lens t Text
Lens (Service srcAnnot) Text
name Text
n Service srcAnnot
d

instance HasSrcAnnot Definition where
    srcAnnot :: forall a. Lens (Definition a) a
srcAnnot = (Definition a -> a)
-> (Definition a -> a -> Definition a) -> Lens (Definition a) a
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Definition a -> a
forall {srcAnnot}. Definition srcAnnot -> srcAnnot
getter Definition a -> a -> Definition a
forall {srcAnnot}.
Definition srcAnnot -> srcAnnot -> Definition srcAnnot
setter
      where
        getter :: Definition srcAnnot -> srcAnnot
getter (ConstDefinition   Const srcAnnot
d) = Lens (Const srcAnnot) srcAnnot -> Const srcAnnot -> srcAnnot
forall s a. Lens s a -> s -> a
view (srcAnnot -> f srcAnnot) -> Const srcAnnot -> f (Const srcAnnot)
forall a. Lens (Const a) a
Lens (Const srcAnnot) srcAnnot
forall (t :: * -> *) a. HasSrcAnnot t => Lens (t a) a
srcAnnot Const srcAnnot
d
        getter (TypeDefinition    Type srcAnnot
d) = Lens (Type srcAnnot) srcAnnot -> Type srcAnnot -> srcAnnot
forall s a. Lens s a -> s -> a
view (srcAnnot -> f srcAnnot) -> Type srcAnnot -> f (Type srcAnnot)
forall a. Lens (Type a) a
Lens (Type srcAnnot) srcAnnot
forall (t :: * -> *) a. HasSrcAnnot t => Lens (t a) a
srcAnnot Type srcAnnot
d
        getter (ServiceDefinition Service srcAnnot
d) = Lens (Service srcAnnot) srcAnnot -> Service srcAnnot -> srcAnnot
forall s a. Lens s a -> s -> a
view (srcAnnot -> f srcAnnot)
-> Service srcAnnot -> f (Service srcAnnot)
forall a. Lens (Service a) a
Lens (Service srcAnnot) srcAnnot
forall (t :: * -> *) a. HasSrcAnnot t => Lens (t a) a
srcAnnot Service srcAnnot
d

        setter :: Definition srcAnnot -> srcAnnot -> Definition srcAnnot
setter (ConstDefinition   Const srcAnnot
d) srcAnnot
a = Const srcAnnot -> Definition srcAnnot
forall srcAnnot. Const srcAnnot -> Definition srcAnnot
ConstDefinition   (Const srcAnnot -> Definition srcAnnot)
-> Const srcAnnot -> Definition srcAnnot
forall a b. (a -> b) -> a -> b
$ Lens (Const srcAnnot) srcAnnot
-> srcAnnot -> Const srcAnnot -> Const srcAnnot
forall s a. Lens s a -> a -> s -> s
set (srcAnnot -> f srcAnnot) -> Const srcAnnot -> f (Const srcAnnot)
forall a. Lens (Const a) a
Lens (Const srcAnnot) srcAnnot
forall (t :: * -> *) a. HasSrcAnnot t => Lens (t a) a
srcAnnot srcAnnot
a Const srcAnnot
d
        setter (TypeDefinition    Type srcAnnot
d) srcAnnot
a = Type srcAnnot -> Definition srcAnnot
forall srcAnnot. Type srcAnnot -> Definition srcAnnot
TypeDefinition    (Type srcAnnot -> Definition srcAnnot)
-> Type srcAnnot -> Definition srcAnnot
forall a b. (a -> b) -> a -> b
$ Lens (Type srcAnnot) srcAnnot
-> srcAnnot -> Type srcAnnot -> Type srcAnnot
forall s a. Lens s a -> a -> s -> s
set (srcAnnot -> f srcAnnot) -> Type srcAnnot -> f (Type srcAnnot)
forall a. Lens (Type a) a
Lens (Type srcAnnot) srcAnnot
forall (t :: * -> *) a. HasSrcAnnot t => Lens (t a) a
srcAnnot srcAnnot
a Type srcAnnot
d
        setter (ServiceDefinition Service srcAnnot
d) srcAnnot
a = Service srcAnnot -> Definition srcAnnot
forall srcAnnot. Service srcAnnot -> Definition srcAnnot
ServiceDefinition (Service srcAnnot -> Definition srcAnnot)
-> Service srcAnnot -> Definition srcAnnot
forall a b. (a -> b) -> a -> b
$ Lens (Service srcAnnot) srcAnnot
-> srcAnnot -> Service srcAnnot -> Service srcAnnot
forall s a. Lens s a -> a -> s -> s
set (srcAnnot -> f srcAnnot)
-> Service srcAnnot -> f (Service srcAnnot)
forall a. Lens (Service a) a
Lens (Service srcAnnot) srcAnnot
forall (t :: * -> *) a. HasSrcAnnot t => Lens (t a) a
srcAnnot srcAnnot
a Service srcAnnot
d


-- | Namespace directives allows control of the namespace or package
-- name used by the generated code for certain languages.
--
-- > namespace py my_service.generated
data Namespace srcAnnot = Namespace
    { forall srcAnnot. Namespace srcAnnot -> Text
namespaceLanguage :: Text
    -- ^ The language for which the namespace is being specified. This may
    -- be @*@ to refer to all languages.
    , forall srcAnnot. Namespace srcAnnot -> Text
namespaceName     :: Text
    -- ^ Namespace or package path to use in the generated code for that
    -- language.
    , forall srcAnnot. Namespace srcAnnot -> srcAnnot
namespaceSrcAnnot :: srcAnnot
    }
    deriving (Int -> Namespace srcAnnot -> ShowS
[Namespace srcAnnot] -> ShowS
Namespace srcAnnot -> String
(Int -> Namespace srcAnnot -> ShowS)
-> (Namespace srcAnnot -> String)
-> ([Namespace srcAnnot] -> ShowS)
-> Show (Namespace srcAnnot)
forall srcAnnot.
Show srcAnnot =>
Int -> Namespace srcAnnot -> ShowS
forall srcAnnot. Show srcAnnot => [Namespace srcAnnot] -> ShowS
forall srcAnnot. Show srcAnnot => Namespace srcAnnot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall srcAnnot.
Show srcAnnot =>
Int -> Namespace srcAnnot -> ShowS
showsPrec :: Int -> Namespace srcAnnot -> ShowS
$cshow :: forall srcAnnot. Show srcAnnot => Namespace srcAnnot -> String
show :: Namespace srcAnnot -> String
$cshowList :: forall srcAnnot. Show srcAnnot => [Namespace srcAnnot] -> ShowS
showList :: [Namespace srcAnnot] -> ShowS
Show, Eq (Namespace srcAnnot)
Eq (Namespace srcAnnot) =>
(Namespace srcAnnot -> Namespace srcAnnot -> Ordering)
-> (Namespace srcAnnot -> Namespace srcAnnot -> Bool)
-> (Namespace srcAnnot -> Namespace srcAnnot -> Bool)
-> (Namespace srcAnnot -> Namespace srcAnnot -> Bool)
-> (Namespace srcAnnot -> Namespace srcAnnot -> Bool)
-> (Namespace srcAnnot -> Namespace srcAnnot -> Namespace srcAnnot)
-> (Namespace srcAnnot -> Namespace srcAnnot -> Namespace srcAnnot)
-> Ord (Namespace srcAnnot)
Namespace srcAnnot -> Namespace srcAnnot -> Bool
Namespace srcAnnot -> Namespace srcAnnot -> Ordering
Namespace srcAnnot -> Namespace srcAnnot -> Namespace srcAnnot
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 srcAnnot. Ord srcAnnot => Eq (Namespace srcAnnot)
forall srcAnnot.
Ord srcAnnot =>
Namespace srcAnnot -> Namespace srcAnnot -> Bool
forall srcAnnot.
Ord srcAnnot =>
Namespace srcAnnot -> Namespace srcAnnot -> Ordering
forall srcAnnot.
Ord srcAnnot =>
Namespace srcAnnot -> Namespace srcAnnot -> Namespace srcAnnot
$ccompare :: forall srcAnnot.
Ord srcAnnot =>
Namespace srcAnnot -> Namespace srcAnnot -> Ordering
compare :: Namespace srcAnnot -> Namespace srcAnnot -> Ordering
$c< :: forall srcAnnot.
Ord srcAnnot =>
Namespace srcAnnot -> Namespace srcAnnot -> Bool
< :: Namespace srcAnnot -> Namespace srcAnnot -> Bool
$c<= :: forall srcAnnot.
Ord srcAnnot =>
Namespace srcAnnot -> Namespace srcAnnot -> Bool
<= :: Namespace srcAnnot -> Namespace srcAnnot -> Bool
$c> :: forall srcAnnot.
Ord srcAnnot =>
Namespace srcAnnot -> Namespace srcAnnot -> Bool
> :: Namespace srcAnnot -> Namespace srcAnnot -> Bool
$c>= :: forall srcAnnot.
Ord srcAnnot =>
Namespace srcAnnot -> Namespace srcAnnot -> Bool
>= :: Namespace srcAnnot -> Namespace srcAnnot -> Bool
$cmax :: forall srcAnnot.
Ord srcAnnot =>
Namespace srcAnnot -> Namespace srcAnnot -> Namespace srcAnnot
max :: Namespace srcAnnot -> Namespace srcAnnot -> Namespace srcAnnot
$cmin :: forall srcAnnot.
Ord srcAnnot =>
Namespace srcAnnot -> Namespace srcAnnot -> Namespace srcAnnot
min :: Namespace srcAnnot -> Namespace srcAnnot -> Namespace srcAnnot
Ord, Namespace srcAnnot -> Namespace srcAnnot -> Bool
(Namespace srcAnnot -> Namespace srcAnnot -> Bool)
-> (Namespace srcAnnot -> Namespace srcAnnot -> Bool)
-> Eq (Namespace srcAnnot)
forall srcAnnot.
Eq srcAnnot =>
Namespace srcAnnot -> Namespace srcAnnot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall srcAnnot.
Eq srcAnnot =>
Namespace srcAnnot -> Namespace srcAnnot -> Bool
== :: Namespace srcAnnot -> Namespace srcAnnot -> Bool
$c/= :: forall srcAnnot.
Eq srcAnnot =>
Namespace srcAnnot -> Namespace srcAnnot -> Bool
/= :: Namespace srcAnnot -> Namespace srcAnnot -> Bool
Eq, Typeable (Namespace srcAnnot)
Typeable (Namespace srcAnnot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> Namespace srcAnnot
 -> c (Namespace srcAnnot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Namespace srcAnnot))
-> (Namespace srcAnnot -> Constr)
-> (Namespace srcAnnot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Namespace srcAnnot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Namespace srcAnnot)))
-> ((forall b. Data b => b -> b)
    -> Namespace srcAnnot -> Namespace srcAnnot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Namespace srcAnnot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Namespace srcAnnot -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> Namespace srcAnnot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Namespace srcAnnot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> Namespace srcAnnot -> m (Namespace srcAnnot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Namespace srcAnnot -> m (Namespace srcAnnot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Namespace srcAnnot -> m (Namespace srcAnnot))
-> Data (Namespace srcAnnot)
Namespace srcAnnot -> Constr
Namespace srcAnnot -> DataType
(forall b. Data b => b -> b)
-> Namespace srcAnnot -> Namespace srcAnnot
forall srcAnnot. Data srcAnnot => Typeable (Namespace srcAnnot)
forall srcAnnot. Data srcAnnot => Namespace srcAnnot -> Constr
forall srcAnnot. Data srcAnnot => Namespace srcAnnot -> DataType
forall srcAnnot.
Data srcAnnot =>
(forall b. Data b => b -> b)
-> Namespace srcAnnot -> Namespace srcAnnot
forall srcAnnot u.
Data srcAnnot =>
Int -> (forall d. Data d => d -> u) -> Namespace srcAnnot -> u
forall srcAnnot u.
Data srcAnnot =>
(forall d. Data d => d -> u) -> Namespace srcAnnot -> [u]
forall srcAnnot r r'.
Data srcAnnot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Namespace srcAnnot -> r
forall srcAnnot r r'.
Data srcAnnot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Namespace srcAnnot -> r
forall srcAnnot (m :: * -> *).
(Data srcAnnot, Monad m) =>
(forall d. Data d => d -> m d)
-> Namespace srcAnnot -> m (Namespace srcAnnot)
forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Namespace srcAnnot -> m (Namespace srcAnnot)
forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Namespace srcAnnot)
forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Namespace srcAnnot
-> c (Namespace srcAnnot)
forall srcAnnot (t :: * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Namespace srcAnnot))
forall srcAnnot (t :: * -> * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Namespace srcAnnot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> Namespace srcAnnot -> u
forall u. (forall d. Data d => d -> u) -> Namespace srcAnnot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Namespace srcAnnot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Namespace srcAnnot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Namespace srcAnnot -> m (Namespace srcAnnot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Namespace srcAnnot -> m (Namespace srcAnnot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Namespace srcAnnot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Namespace srcAnnot
-> c (Namespace srcAnnot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Namespace srcAnnot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Namespace srcAnnot))
$cgfoldl :: forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Namespace srcAnnot
-> c (Namespace srcAnnot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Namespace srcAnnot
-> c (Namespace srcAnnot)
$cgunfold :: forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Namespace srcAnnot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Namespace srcAnnot)
$ctoConstr :: forall srcAnnot. Data srcAnnot => Namespace srcAnnot -> Constr
toConstr :: Namespace srcAnnot -> Constr
$cdataTypeOf :: forall srcAnnot. Data srcAnnot => Namespace srcAnnot -> DataType
dataTypeOf :: Namespace srcAnnot -> DataType
$cdataCast1 :: forall srcAnnot (t :: * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Namespace srcAnnot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Namespace srcAnnot))
$cdataCast2 :: forall srcAnnot (t :: * -> * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Namespace srcAnnot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Namespace srcAnnot))
$cgmapT :: forall srcAnnot.
Data srcAnnot =>
(forall b. Data b => b -> b)
-> Namespace srcAnnot -> Namespace srcAnnot
gmapT :: (forall b. Data b => b -> b)
-> Namespace srcAnnot -> Namespace srcAnnot
$cgmapQl :: forall srcAnnot r r'.
Data srcAnnot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Namespace srcAnnot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Namespace srcAnnot -> r
$cgmapQr :: forall srcAnnot r r'.
Data srcAnnot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Namespace srcAnnot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Namespace srcAnnot -> r
$cgmapQ :: forall srcAnnot u.
Data srcAnnot =>
(forall d. Data d => d -> u) -> Namespace srcAnnot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Namespace srcAnnot -> [u]
$cgmapQi :: forall srcAnnot u.
Data srcAnnot =>
Int -> (forall d. Data d => d -> u) -> Namespace srcAnnot -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> Namespace srcAnnot -> u
$cgmapM :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, Monad m) =>
(forall d. Data d => d -> m d)
-> Namespace srcAnnot -> m (Namespace srcAnnot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Namespace srcAnnot -> m (Namespace srcAnnot)
$cgmapMp :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Namespace srcAnnot -> m (Namespace srcAnnot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Namespace srcAnnot -> m (Namespace srcAnnot)
$cgmapMo :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Namespace srcAnnot -> m (Namespace srcAnnot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Namespace srcAnnot -> m (Namespace srcAnnot)
Data, Typeable, (forall x. Namespace srcAnnot -> Rep (Namespace srcAnnot) x)
-> (forall x. Rep (Namespace srcAnnot) x -> Namespace srcAnnot)
-> Generic (Namespace srcAnnot)
forall x. Rep (Namespace srcAnnot) x -> Namespace srcAnnot
forall x. Namespace srcAnnot -> Rep (Namespace srcAnnot) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall srcAnnot x. Rep (Namespace srcAnnot) x -> Namespace srcAnnot
forall srcAnnot x. Namespace srcAnnot -> Rep (Namespace srcAnnot) x
$cfrom :: forall srcAnnot x. Namespace srcAnnot -> Rep (Namespace srcAnnot) x
from :: forall x. Namespace srcAnnot -> Rep (Namespace srcAnnot) x
$cto :: forall srcAnnot x. Rep (Namespace srcAnnot) x -> Namespace srcAnnot
to :: forall x. Rep (Namespace srcAnnot) x -> Namespace srcAnnot
Generic, (forall a b. (a -> b) -> Namespace a -> Namespace b)
-> (forall a b. a -> Namespace b -> Namespace a)
-> Functor Namespace
forall a b. a -> Namespace b -> Namespace a
forall a b. (a -> b) -> Namespace a -> Namespace b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Namespace a -> Namespace b
fmap :: forall a b. (a -> b) -> Namespace a -> Namespace b
$c<$ :: forall a b. a -> Namespace b -> Namespace a
<$ :: forall a b. a -> Namespace b -> Namespace a
Functor)

language :: Lens (Namespace a) Text
language :: forall a (f :: * -> *).
Functor f =>
(Text -> f Text) -> Namespace a -> f (Namespace a)
language = (Namespace a -> Text)
-> (Namespace a -> Text -> Namespace a) -> Lens (Namespace a) Text
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Namespace a -> Text
forall srcAnnot. Namespace srcAnnot -> Text
namespaceLanguage (\Namespace a
s Text
a -> Namespace a
s { namespaceLanguage = a })

instance HasName (Namespace a) where
    name :: Lens (Namespace a) Text
name = (Namespace a -> Text)
-> (Namespace a -> Text -> Namespace a) -> Lens (Namespace a) Text
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Namespace a -> Text
forall srcAnnot. Namespace srcAnnot -> Text
namespaceName (\Namespace a
s Text
a -> Namespace a
s { namespaceName = a })

instance HasSrcAnnot Namespace where
    srcAnnot :: forall a. Lens (Namespace a) a
srcAnnot = (Namespace a -> a)
-> (Namespace a -> a -> Namespace a) -> Lens (Namespace a) a
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Namespace a -> a
forall srcAnnot. Namespace srcAnnot -> srcAnnot
namespaceSrcAnnot (\Namespace a
s a
a -> Namespace a
s { namespaceSrcAnnot = a })

-- | The IDL includes another Thrift file.
--
-- > include "common.thrift"
-- >
-- > typedef common.Foo Bar
--
data Include srcAnnot = Include
    { forall srcAnnot. Include srcAnnot -> Text
includePath     :: Text
    -- ^ Path to the included file.
    , forall srcAnnot. Include srcAnnot -> srcAnnot
includeSrcAnnot :: srcAnnot
    }
    deriving (Int -> Include srcAnnot -> ShowS
[Include srcAnnot] -> ShowS
Include srcAnnot -> String
(Int -> Include srcAnnot -> ShowS)
-> (Include srcAnnot -> String)
-> ([Include srcAnnot] -> ShowS)
-> Show (Include srcAnnot)
forall srcAnnot. Show srcAnnot => Int -> Include srcAnnot -> ShowS
forall srcAnnot. Show srcAnnot => [Include srcAnnot] -> ShowS
forall srcAnnot. Show srcAnnot => Include srcAnnot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall srcAnnot. Show srcAnnot => Int -> Include srcAnnot -> ShowS
showsPrec :: Int -> Include srcAnnot -> ShowS
$cshow :: forall srcAnnot. Show srcAnnot => Include srcAnnot -> String
show :: Include srcAnnot -> String
$cshowList :: forall srcAnnot. Show srcAnnot => [Include srcAnnot] -> ShowS
showList :: [Include srcAnnot] -> ShowS
Show, Eq (Include srcAnnot)
Eq (Include srcAnnot) =>
(Include srcAnnot -> Include srcAnnot -> Ordering)
-> (Include srcAnnot -> Include srcAnnot -> Bool)
-> (Include srcAnnot -> Include srcAnnot -> Bool)
-> (Include srcAnnot -> Include srcAnnot -> Bool)
-> (Include srcAnnot -> Include srcAnnot -> Bool)
-> (Include srcAnnot -> Include srcAnnot -> Include srcAnnot)
-> (Include srcAnnot -> Include srcAnnot -> Include srcAnnot)
-> Ord (Include srcAnnot)
Include srcAnnot -> Include srcAnnot -> Bool
Include srcAnnot -> Include srcAnnot -> Ordering
Include srcAnnot -> Include srcAnnot -> Include srcAnnot
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 srcAnnot. Ord srcAnnot => Eq (Include srcAnnot)
forall srcAnnot.
Ord srcAnnot =>
Include srcAnnot -> Include srcAnnot -> Bool
forall srcAnnot.
Ord srcAnnot =>
Include srcAnnot -> Include srcAnnot -> Ordering
forall srcAnnot.
Ord srcAnnot =>
Include srcAnnot -> Include srcAnnot -> Include srcAnnot
$ccompare :: forall srcAnnot.
Ord srcAnnot =>
Include srcAnnot -> Include srcAnnot -> Ordering
compare :: Include srcAnnot -> Include srcAnnot -> Ordering
$c< :: forall srcAnnot.
Ord srcAnnot =>
Include srcAnnot -> Include srcAnnot -> Bool
< :: Include srcAnnot -> Include srcAnnot -> Bool
$c<= :: forall srcAnnot.
Ord srcAnnot =>
Include srcAnnot -> Include srcAnnot -> Bool
<= :: Include srcAnnot -> Include srcAnnot -> Bool
$c> :: forall srcAnnot.
Ord srcAnnot =>
Include srcAnnot -> Include srcAnnot -> Bool
> :: Include srcAnnot -> Include srcAnnot -> Bool
$c>= :: forall srcAnnot.
Ord srcAnnot =>
Include srcAnnot -> Include srcAnnot -> Bool
>= :: Include srcAnnot -> Include srcAnnot -> Bool
$cmax :: forall srcAnnot.
Ord srcAnnot =>
Include srcAnnot -> Include srcAnnot -> Include srcAnnot
max :: Include srcAnnot -> Include srcAnnot -> Include srcAnnot
$cmin :: forall srcAnnot.
Ord srcAnnot =>
Include srcAnnot -> Include srcAnnot -> Include srcAnnot
min :: Include srcAnnot -> Include srcAnnot -> Include srcAnnot
Ord, Include srcAnnot -> Include srcAnnot -> Bool
(Include srcAnnot -> Include srcAnnot -> Bool)
-> (Include srcAnnot -> Include srcAnnot -> Bool)
-> Eq (Include srcAnnot)
forall srcAnnot.
Eq srcAnnot =>
Include srcAnnot -> Include srcAnnot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall srcAnnot.
Eq srcAnnot =>
Include srcAnnot -> Include srcAnnot -> Bool
== :: Include srcAnnot -> Include srcAnnot -> Bool
$c/= :: forall srcAnnot.
Eq srcAnnot =>
Include srcAnnot -> Include srcAnnot -> Bool
/= :: Include srcAnnot -> Include srcAnnot -> Bool
Eq, Typeable (Include srcAnnot)
Typeable (Include srcAnnot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> Include srcAnnot
 -> c (Include srcAnnot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Include srcAnnot))
-> (Include srcAnnot -> Constr)
-> (Include srcAnnot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Include srcAnnot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Include srcAnnot)))
-> ((forall b. Data b => b -> b)
    -> Include srcAnnot -> Include srcAnnot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Include srcAnnot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Include srcAnnot -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> Include srcAnnot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Include srcAnnot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> Include srcAnnot -> m (Include srcAnnot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Include srcAnnot -> m (Include srcAnnot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Include srcAnnot -> m (Include srcAnnot))
-> Data (Include srcAnnot)
Include srcAnnot -> Constr
Include srcAnnot -> DataType
(forall b. Data b => b -> b)
-> Include srcAnnot -> Include srcAnnot
forall srcAnnot. Data srcAnnot => Typeable (Include srcAnnot)
forall srcAnnot. Data srcAnnot => Include srcAnnot -> Constr
forall srcAnnot. Data srcAnnot => Include srcAnnot -> DataType
forall srcAnnot.
Data srcAnnot =>
(forall b. Data b => b -> b)
-> Include srcAnnot -> Include srcAnnot
forall srcAnnot u.
Data srcAnnot =>
Int -> (forall d. Data d => d -> u) -> Include srcAnnot -> u
forall srcAnnot u.
Data srcAnnot =>
(forall d. Data d => d -> u) -> Include srcAnnot -> [u]
forall srcAnnot r r'.
Data srcAnnot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Include srcAnnot -> r
forall srcAnnot r r'.
Data srcAnnot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Include srcAnnot -> r
forall srcAnnot (m :: * -> *).
(Data srcAnnot, Monad m) =>
(forall d. Data d => d -> m d)
-> Include srcAnnot -> m (Include srcAnnot)
forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Include srcAnnot -> m (Include srcAnnot)
forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Include srcAnnot)
forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Include srcAnnot -> c (Include srcAnnot)
forall srcAnnot (t :: * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Include srcAnnot))
forall srcAnnot (t :: * -> * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Include srcAnnot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> Include srcAnnot -> u
forall u. (forall d. Data d => d -> u) -> Include srcAnnot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Include srcAnnot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Include srcAnnot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Include srcAnnot -> m (Include srcAnnot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Include srcAnnot -> m (Include srcAnnot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Include srcAnnot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Include srcAnnot -> c (Include srcAnnot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Include srcAnnot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Include srcAnnot))
$cgfoldl :: forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Include srcAnnot -> c (Include srcAnnot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Include srcAnnot -> c (Include srcAnnot)
$cgunfold :: forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Include srcAnnot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Include srcAnnot)
$ctoConstr :: forall srcAnnot. Data srcAnnot => Include srcAnnot -> Constr
toConstr :: Include srcAnnot -> Constr
$cdataTypeOf :: forall srcAnnot. Data srcAnnot => Include srcAnnot -> DataType
dataTypeOf :: Include srcAnnot -> DataType
$cdataCast1 :: forall srcAnnot (t :: * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Include srcAnnot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Include srcAnnot))
$cdataCast2 :: forall srcAnnot (t :: * -> * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Include srcAnnot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Include srcAnnot))
$cgmapT :: forall srcAnnot.
Data srcAnnot =>
(forall b. Data b => b -> b)
-> Include srcAnnot -> Include srcAnnot
gmapT :: (forall b. Data b => b -> b)
-> Include srcAnnot -> Include srcAnnot
$cgmapQl :: forall srcAnnot r r'.
Data srcAnnot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Include srcAnnot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Include srcAnnot -> r
$cgmapQr :: forall srcAnnot r r'.
Data srcAnnot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Include srcAnnot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Include srcAnnot -> r
$cgmapQ :: forall srcAnnot u.
Data srcAnnot =>
(forall d. Data d => d -> u) -> Include srcAnnot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Include srcAnnot -> [u]
$cgmapQi :: forall srcAnnot u.
Data srcAnnot =>
Int -> (forall d. Data d => d -> u) -> Include srcAnnot -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> Include srcAnnot -> u
$cgmapM :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, Monad m) =>
(forall d. Data d => d -> m d)
-> Include srcAnnot -> m (Include srcAnnot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Include srcAnnot -> m (Include srcAnnot)
$cgmapMp :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Include srcAnnot -> m (Include srcAnnot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Include srcAnnot -> m (Include srcAnnot)
$cgmapMo :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Include srcAnnot -> m (Include srcAnnot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Include srcAnnot -> m (Include srcAnnot)
Data, Typeable, (forall x. Include srcAnnot -> Rep (Include srcAnnot) x)
-> (forall x. Rep (Include srcAnnot) x -> Include srcAnnot)
-> Generic (Include srcAnnot)
forall x. Rep (Include srcAnnot) x -> Include srcAnnot
forall x. Include srcAnnot -> Rep (Include srcAnnot) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall srcAnnot x. Rep (Include srcAnnot) x -> Include srcAnnot
forall srcAnnot x. Include srcAnnot -> Rep (Include srcAnnot) x
$cfrom :: forall srcAnnot x. Include srcAnnot -> Rep (Include srcAnnot) x
from :: forall x. Include srcAnnot -> Rep (Include srcAnnot) x
$cto :: forall srcAnnot x. Rep (Include srcAnnot) x -> Include srcAnnot
to :: forall x. Rep (Include srcAnnot) x -> Include srcAnnot
Generic, (forall a b. (a -> b) -> Include a -> Include b)
-> (forall a b. a -> Include b -> Include a) -> Functor Include
forall a b. a -> Include b -> Include a
forall a b. (a -> b) -> Include a -> Include b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Include a -> Include b
fmap :: forall a b. (a -> b) -> Include a -> Include b
$c<$ :: forall a b. a -> Include b -> Include a
<$ :: forall a b. a -> Include b -> Include a
Functor)

path :: Lens (Include a) Text
path :: forall a (f :: * -> *).
Functor f =>
(Text -> f Text) -> Include a -> f (Include a)
path = (Include a -> Text)
-> (Include a -> Text -> Include a) -> Lens (Include a) Text
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Include a -> Text
forall srcAnnot. Include srcAnnot -> Text
includePath (\Include a
s Text
a -> Include a
s { includePath = a })

instance HasSrcAnnot Include where
    srcAnnot :: forall a. Lens (Include a) a
srcAnnot = (Include a -> a)
-> (Include a -> a -> Include a) -> Lens (Include a) a
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Include a -> a
forall srcAnnot. Include srcAnnot -> srcAnnot
includeSrcAnnot (\Include a
s a
a -> Include a
s { includeSrcAnnot = a })

-- | Headers for a program.
data Header srcAnnot
    = -- | Request to include another Thrift file.
      HeaderInclude (Include srcAnnot)
    | -- | A @namespace@ specifier.
      HeaderNamespace (Namespace srcAnnot)
    deriving (Int -> Header srcAnnot -> ShowS
[Header srcAnnot] -> ShowS
Header srcAnnot -> String
(Int -> Header srcAnnot -> ShowS)
-> (Header srcAnnot -> String)
-> ([Header srcAnnot] -> ShowS)
-> Show (Header srcAnnot)
forall srcAnnot. Show srcAnnot => Int -> Header srcAnnot -> ShowS
forall srcAnnot. Show srcAnnot => [Header srcAnnot] -> ShowS
forall srcAnnot. Show srcAnnot => Header srcAnnot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall srcAnnot. Show srcAnnot => Int -> Header srcAnnot -> ShowS
showsPrec :: Int -> Header srcAnnot -> ShowS
$cshow :: forall srcAnnot. Show srcAnnot => Header srcAnnot -> String
show :: Header srcAnnot -> String
$cshowList :: forall srcAnnot. Show srcAnnot => [Header srcAnnot] -> ShowS
showList :: [Header srcAnnot] -> ShowS
Show, Eq (Header srcAnnot)
Eq (Header srcAnnot) =>
(Header srcAnnot -> Header srcAnnot -> Ordering)
-> (Header srcAnnot -> Header srcAnnot -> Bool)
-> (Header srcAnnot -> Header srcAnnot -> Bool)
-> (Header srcAnnot -> Header srcAnnot -> Bool)
-> (Header srcAnnot -> Header srcAnnot -> Bool)
-> (Header srcAnnot -> Header srcAnnot -> Header srcAnnot)
-> (Header srcAnnot -> Header srcAnnot -> Header srcAnnot)
-> Ord (Header srcAnnot)
Header srcAnnot -> Header srcAnnot -> Bool
Header srcAnnot -> Header srcAnnot -> Ordering
Header srcAnnot -> Header srcAnnot -> Header srcAnnot
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 srcAnnot. Ord srcAnnot => Eq (Header srcAnnot)
forall srcAnnot.
Ord srcAnnot =>
Header srcAnnot -> Header srcAnnot -> Bool
forall srcAnnot.
Ord srcAnnot =>
Header srcAnnot -> Header srcAnnot -> Ordering
forall srcAnnot.
Ord srcAnnot =>
Header srcAnnot -> Header srcAnnot -> Header srcAnnot
$ccompare :: forall srcAnnot.
Ord srcAnnot =>
Header srcAnnot -> Header srcAnnot -> Ordering
compare :: Header srcAnnot -> Header srcAnnot -> Ordering
$c< :: forall srcAnnot.
Ord srcAnnot =>
Header srcAnnot -> Header srcAnnot -> Bool
< :: Header srcAnnot -> Header srcAnnot -> Bool
$c<= :: forall srcAnnot.
Ord srcAnnot =>
Header srcAnnot -> Header srcAnnot -> Bool
<= :: Header srcAnnot -> Header srcAnnot -> Bool
$c> :: forall srcAnnot.
Ord srcAnnot =>
Header srcAnnot -> Header srcAnnot -> Bool
> :: Header srcAnnot -> Header srcAnnot -> Bool
$c>= :: forall srcAnnot.
Ord srcAnnot =>
Header srcAnnot -> Header srcAnnot -> Bool
>= :: Header srcAnnot -> Header srcAnnot -> Bool
$cmax :: forall srcAnnot.
Ord srcAnnot =>
Header srcAnnot -> Header srcAnnot -> Header srcAnnot
max :: Header srcAnnot -> Header srcAnnot -> Header srcAnnot
$cmin :: forall srcAnnot.
Ord srcAnnot =>
Header srcAnnot -> Header srcAnnot -> Header srcAnnot
min :: Header srcAnnot -> Header srcAnnot -> Header srcAnnot
Ord, Header srcAnnot -> Header srcAnnot -> Bool
(Header srcAnnot -> Header srcAnnot -> Bool)
-> (Header srcAnnot -> Header srcAnnot -> Bool)
-> Eq (Header srcAnnot)
forall srcAnnot.
Eq srcAnnot =>
Header srcAnnot -> Header srcAnnot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall srcAnnot.
Eq srcAnnot =>
Header srcAnnot -> Header srcAnnot -> Bool
== :: Header srcAnnot -> Header srcAnnot -> Bool
$c/= :: forall srcAnnot.
Eq srcAnnot =>
Header srcAnnot -> Header srcAnnot -> Bool
/= :: Header srcAnnot -> Header srcAnnot -> Bool
Eq, Typeable (Header srcAnnot)
Typeable (Header srcAnnot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Header srcAnnot -> c (Header srcAnnot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Header srcAnnot))
-> (Header srcAnnot -> Constr)
-> (Header srcAnnot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Header srcAnnot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Header srcAnnot)))
-> ((forall b. Data b => b -> b)
    -> Header srcAnnot -> Header srcAnnot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Header srcAnnot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Header srcAnnot -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> Header srcAnnot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Header srcAnnot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> Header srcAnnot -> m (Header srcAnnot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Header srcAnnot -> m (Header srcAnnot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Header srcAnnot -> m (Header srcAnnot))
-> Data (Header srcAnnot)
Header srcAnnot -> Constr
Header srcAnnot -> DataType
(forall b. Data b => b -> b) -> Header srcAnnot -> Header srcAnnot
forall srcAnnot. Data srcAnnot => Typeable (Header srcAnnot)
forall srcAnnot. Data srcAnnot => Header srcAnnot -> Constr
forall srcAnnot. Data srcAnnot => Header srcAnnot -> DataType
forall srcAnnot.
Data srcAnnot =>
(forall b. Data b => b -> b) -> Header srcAnnot -> Header srcAnnot
forall srcAnnot u.
Data srcAnnot =>
Int -> (forall d. Data d => d -> u) -> Header srcAnnot -> u
forall srcAnnot u.
Data srcAnnot =>
(forall d. Data d => d -> u) -> Header srcAnnot -> [u]
forall srcAnnot r r'.
Data srcAnnot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Header srcAnnot -> r
forall srcAnnot r r'.
Data srcAnnot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Header srcAnnot -> r
forall srcAnnot (m :: * -> *).
(Data srcAnnot, Monad m) =>
(forall d. Data d => d -> m d)
-> Header srcAnnot -> m (Header srcAnnot)
forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Header srcAnnot -> m (Header srcAnnot)
forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Header srcAnnot)
forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Header srcAnnot -> c (Header srcAnnot)
forall srcAnnot (t :: * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Header srcAnnot))
forall srcAnnot (t :: * -> * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Header srcAnnot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> Header srcAnnot -> u
forall u. (forall d. Data d => d -> u) -> Header srcAnnot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Header srcAnnot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Header srcAnnot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Header srcAnnot -> m (Header srcAnnot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Header srcAnnot -> m (Header srcAnnot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Header srcAnnot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Header srcAnnot -> c (Header srcAnnot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Header srcAnnot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Header srcAnnot))
$cgfoldl :: forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Header srcAnnot -> c (Header srcAnnot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Header srcAnnot -> c (Header srcAnnot)
$cgunfold :: forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Header srcAnnot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Header srcAnnot)
$ctoConstr :: forall srcAnnot. Data srcAnnot => Header srcAnnot -> Constr
toConstr :: Header srcAnnot -> Constr
$cdataTypeOf :: forall srcAnnot. Data srcAnnot => Header srcAnnot -> DataType
dataTypeOf :: Header srcAnnot -> DataType
$cdataCast1 :: forall srcAnnot (t :: * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Header srcAnnot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Header srcAnnot))
$cdataCast2 :: forall srcAnnot (t :: * -> * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Header srcAnnot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Header srcAnnot))
$cgmapT :: forall srcAnnot.
Data srcAnnot =>
(forall b. Data b => b -> b) -> Header srcAnnot -> Header srcAnnot
gmapT :: (forall b. Data b => b -> b) -> Header srcAnnot -> Header srcAnnot
$cgmapQl :: forall srcAnnot r r'.
Data srcAnnot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Header srcAnnot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Header srcAnnot -> r
$cgmapQr :: forall srcAnnot r r'.
Data srcAnnot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Header srcAnnot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Header srcAnnot -> r
$cgmapQ :: forall srcAnnot u.
Data srcAnnot =>
(forall d. Data d => d -> u) -> Header srcAnnot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Header srcAnnot -> [u]
$cgmapQi :: forall srcAnnot u.
Data srcAnnot =>
Int -> (forall d. Data d => d -> u) -> Header srcAnnot -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> Header srcAnnot -> u
$cgmapM :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, Monad m) =>
(forall d. Data d => d -> m d)
-> Header srcAnnot -> m (Header srcAnnot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Header srcAnnot -> m (Header srcAnnot)
$cgmapMp :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Header srcAnnot -> m (Header srcAnnot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Header srcAnnot -> m (Header srcAnnot)
$cgmapMo :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Header srcAnnot -> m (Header srcAnnot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Header srcAnnot -> m (Header srcAnnot)
Data, Typeable, (forall x. Header srcAnnot -> Rep (Header srcAnnot) x)
-> (forall x. Rep (Header srcAnnot) x -> Header srcAnnot)
-> Generic (Header srcAnnot)
forall x. Rep (Header srcAnnot) x -> Header srcAnnot
forall x. Header srcAnnot -> Rep (Header srcAnnot) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall srcAnnot x. Rep (Header srcAnnot) x -> Header srcAnnot
forall srcAnnot x. Header srcAnnot -> Rep (Header srcAnnot) x
$cfrom :: forall srcAnnot x. Header srcAnnot -> Rep (Header srcAnnot) x
from :: forall x. Header srcAnnot -> Rep (Header srcAnnot) x
$cto :: forall srcAnnot x. Rep (Header srcAnnot) x -> Header srcAnnot
to :: forall x. Rep (Header srcAnnot) x -> Header srcAnnot
Generic, (forall a b. (a -> b) -> Header a -> Header b)
-> (forall a b. a -> Header b -> Header a) -> Functor Header
forall a b. a -> Header b -> Header a
forall a b. (a -> b) -> Header a -> Header b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Header a -> Header b
fmap :: forall a b. (a -> b) -> Header a -> Header b
$c<$ :: forall a b. a -> Header b -> Header a
<$ :: forall a b. a -> Header b -> Header a
Functor)

-- | A program represents a single Thrift document.
data Program srcAnnot = Program
    { forall srcAnnot. Program srcAnnot -> [Header srcAnnot]
programHeaders     :: [Header srcAnnot]
    -- ^ Headers in a document define includes and namespaces.
    , forall srcAnnot. Program srcAnnot -> [Definition srcAnnot]
programDefinitions :: [Definition srcAnnot]
    -- ^ Types and services defined in the document.
    }
    deriving (Int -> Program srcAnnot -> ShowS
[Program srcAnnot] -> ShowS
Program srcAnnot -> String
(Int -> Program srcAnnot -> ShowS)
-> (Program srcAnnot -> String)
-> ([Program srcAnnot] -> ShowS)
-> Show (Program srcAnnot)
forall srcAnnot. Show srcAnnot => Int -> Program srcAnnot -> ShowS
forall srcAnnot. Show srcAnnot => [Program srcAnnot] -> ShowS
forall srcAnnot. Show srcAnnot => Program srcAnnot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall srcAnnot. Show srcAnnot => Int -> Program srcAnnot -> ShowS
showsPrec :: Int -> Program srcAnnot -> ShowS
$cshow :: forall srcAnnot. Show srcAnnot => Program srcAnnot -> String
show :: Program srcAnnot -> String
$cshowList :: forall srcAnnot. Show srcAnnot => [Program srcAnnot] -> ShowS
showList :: [Program srcAnnot] -> ShowS
Show, Eq (Program srcAnnot)
Eq (Program srcAnnot) =>
(Program srcAnnot -> Program srcAnnot -> Ordering)
-> (Program srcAnnot -> Program srcAnnot -> Bool)
-> (Program srcAnnot -> Program srcAnnot -> Bool)
-> (Program srcAnnot -> Program srcAnnot -> Bool)
-> (Program srcAnnot -> Program srcAnnot -> Bool)
-> (Program srcAnnot -> Program srcAnnot -> Program srcAnnot)
-> (Program srcAnnot -> Program srcAnnot -> Program srcAnnot)
-> Ord (Program srcAnnot)
Program srcAnnot -> Program srcAnnot -> Bool
Program srcAnnot -> Program srcAnnot -> Ordering
Program srcAnnot -> Program srcAnnot -> Program srcAnnot
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 srcAnnot. Ord srcAnnot => Eq (Program srcAnnot)
forall srcAnnot.
Ord srcAnnot =>
Program srcAnnot -> Program srcAnnot -> Bool
forall srcAnnot.
Ord srcAnnot =>
Program srcAnnot -> Program srcAnnot -> Ordering
forall srcAnnot.
Ord srcAnnot =>
Program srcAnnot -> Program srcAnnot -> Program srcAnnot
$ccompare :: forall srcAnnot.
Ord srcAnnot =>
Program srcAnnot -> Program srcAnnot -> Ordering
compare :: Program srcAnnot -> Program srcAnnot -> Ordering
$c< :: forall srcAnnot.
Ord srcAnnot =>
Program srcAnnot -> Program srcAnnot -> Bool
< :: Program srcAnnot -> Program srcAnnot -> Bool
$c<= :: forall srcAnnot.
Ord srcAnnot =>
Program srcAnnot -> Program srcAnnot -> Bool
<= :: Program srcAnnot -> Program srcAnnot -> Bool
$c> :: forall srcAnnot.
Ord srcAnnot =>
Program srcAnnot -> Program srcAnnot -> Bool
> :: Program srcAnnot -> Program srcAnnot -> Bool
$c>= :: forall srcAnnot.
Ord srcAnnot =>
Program srcAnnot -> Program srcAnnot -> Bool
>= :: Program srcAnnot -> Program srcAnnot -> Bool
$cmax :: forall srcAnnot.
Ord srcAnnot =>
Program srcAnnot -> Program srcAnnot -> Program srcAnnot
max :: Program srcAnnot -> Program srcAnnot -> Program srcAnnot
$cmin :: forall srcAnnot.
Ord srcAnnot =>
Program srcAnnot -> Program srcAnnot -> Program srcAnnot
min :: Program srcAnnot -> Program srcAnnot -> Program srcAnnot
Ord, Program srcAnnot -> Program srcAnnot -> Bool
(Program srcAnnot -> Program srcAnnot -> Bool)
-> (Program srcAnnot -> Program srcAnnot -> Bool)
-> Eq (Program srcAnnot)
forall srcAnnot.
Eq srcAnnot =>
Program srcAnnot -> Program srcAnnot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall srcAnnot.
Eq srcAnnot =>
Program srcAnnot -> Program srcAnnot -> Bool
== :: Program srcAnnot -> Program srcAnnot -> Bool
$c/= :: forall srcAnnot.
Eq srcAnnot =>
Program srcAnnot -> Program srcAnnot -> Bool
/= :: Program srcAnnot -> Program srcAnnot -> Bool
Eq, Typeable (Program srcAnnot)
Typeable (Program srcAnnot) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> Program srcAnnot
 -> c (Program srcAnnot))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Program srcAnnot))
-> (Program srcAnnot -> Constr)
-> (Program srcAnnot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Program srcAnnot)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Program srcAnnot)))
-> ((forall b. Data b => b -> b)
    -> Program srcAnnot -> Program srcAnnot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Program srcAnnot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Program srcAnnot -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> Program srcAnnot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Program srcAnnot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> Program srcAnnot -> m (Program srcAnnot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Program srcAnnot -> m (Program srcAnnot))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Program srcAnnot -> m (Program srcAnnot))
-> Data (Program srcAnnot)
Program srcAnnot -> Constr
Program srcAnnot -> DataType
(forall b. Data b => b -> b)
-> Program srcAnnot -> Program srcAnnot
forall srcAnnot. Data srcAnnot => Typeable (Program srcAnnot)
forall srcAnnot. Data srcAnnot => Program srcAnnot -> Constr
forall srcAnnot. Data srcAnnot => Program srcAnnot -> DataType
forall srcAnnot.
Data srcAnnot =>
(forall b. Data b => b -> b)
-> Program srcAnnot -> Program srcAnnot
forall srcAnnot u.
Data srcAnnot =>
Int -> (forall d. Data d => d -> u) -> Program srcAnnot -> u
forall srcAnnot u.
Data srcAnnot =>
(forall d. Data d => d -> u) -> Program srcAnnot -> [u]
forall srcAnnot r r'.
Data srcAnnot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Program srcAnnot -> r
forall srcAnnot r r'.
Data srcAnnot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Program srcAnnot -> r
forall srcAnnot (m :: * -> *).
(Data srcAnnot, Monad m) =>
(forall d. Data d => d -> m d)
-> Program srcAnnot -> m (Program srcAnnot)
forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Program srcAnnot -> m (Program srcAnnot)
forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Program srcAnnot)
forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Program srcAnnot -> c (Program srcAnnot)
forall srcAnnot (t :: * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Program srcAnnot))
forall srcAnnot (t :: * -> * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Program srcAnnot))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> Program srcAnnot -> u
forall u. (forall d. Data d => d -> u) -> Program srcAnnot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Program srcAnnot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Program srcAnnot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Program srcAnnot -> m (Program srcAnnot)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Program srcAnnot -> m (Program srcAnnot)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Program srcAnnot)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Program srcAnnot -> c (Program srcAnnot)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Program srcAnnot))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Program srcAnnot))
$cgfoldl :: forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Program srcAnnot -> c (Program srcAnnot)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Program srcAnnot -> c (Program srcAnnot)
$cgunfold :: forall srcAnnot (c :: * -> *).
Data srcAnnot =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Program srcAnnot)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Program srcAnnot)
$ctoConstr :: forall srcAnnot. Data srcAnnot => Program srcAnnot -> Constr
toConstr :: Program srcAnnot -> Constr
$cdataTypeOf :: forall srcAnnot. Data srcAnnot => Program srcAnnot -> DataType
dataTypeOf :: Program srcAnnot -> DataType
$cdataCast1 :: forall srcAnnot (t :: * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Program srcAnnot))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Program srcAnnot))
$cdataCast2 :: forall srcAnnot (t :: * -> * -> *) (c :: * -> *).
(Data srcAnnot, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Program srcAnnot))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Program srcAnnot))
$cgmapT :: forall srcAnnot.
Data srcAnnot =>
(forall b. Data b => b -> b)
-> Program srcAnnot -> Program srcAnnot
gmapT :: (forall b. Data b => b -> b)
-> Program srcAnnot -> Program srcAnnot
$cgmapQl :: forall srcAnnot r r'.
Data srcAnnot =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Program srcAnnot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Program srcAnnot -> r
$cgmapQr :: forall srcAnnot r r'.
Data srcAnnot =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Program srcAnnot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Program srcAnnot -> r
$cgmapQ :: forall srcAnnot u.
Data srcAnnot =>
(forall d. Data d => d -> u) -> Program srcAnnot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Program srcAnnot -> [u]
$cgmapQi :: forall srcAnnot u.
Data srcAnnot =>
Int -> (forall d. Data d => d -> u) -> Program srcAnnot -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> Program srcAnnot -> u
$cgmapM :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, Monad m) =>
(forall d. Data d => d -> m d)
-> Program srcAnnot -> m (Program srcAnnot)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Program srcAnnot -> m (Program srcAnnot)
$cgmapMp :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Program srcAnnot -> m (Program srcAnnot)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Program srcAnnot -> m (Program srcAnnot)
$cgmapMo :: forall srcAnnot (m :: * -> *).
(Data srcAnnot, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Program srcAnnot -> m (Program srcAnnot)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Program srcAnnot -> m (Program srcAnnot)
Data, Typeable, (forall x. Program srcAnnot -> Rep (Program srcAnnot) x)
-> (forall x. Rep (Program srcAnnot) x -> Program srcAnnot)
-> Generic (Program srcAnnot)
forall x. Rep (Program srcAnnot) x -> Program srcAnnot
forall x. Program srcAnnot -> Rep (Program srcAnnot) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall srcAnnot x. Rep (Program srcAnnot) x -> Program srcAnnot
forall srcAnnot x. Program srcAnnot -> Rep (Program srcAnnot) x
$cfrom :: forall srcAnnot x. Program srcAnnot -> Rep (Program srcAnnot) x
from :: forall x. Program srcAnnot -> Rep (Program srcAnnot) x
$cto :: forall srcAnnot x. Rep (Program srcAnnot) x -> Program srcAnnot
to :: forall x. Rep (Program srcAnnot) x -> Program srcAnnot
Generic, (forall a b. (a -> b) -> Program a -> Program b)
-> (forall a b. a -> Program b -> Program a) -> Functor Program
forall a b. a -> Program b -> Program a
forall a b. (a -> b) -> Program a -> Program b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Program a -> Program b
fmap :: forall a b. (a -> b) -> Program a -> Program b
$c<$ :: forall a b. a -> Program b -> Program a
<$ :: forall a b. a -> Program b -> Program a
Functor)

headers :: Lens (Program a) [Header a]
headers :: forall a (f :: * -> *).
Functor f =>
([Header a] -> f [Header a]) -> Program a -> f (Program a)
headers = (Program a -> [Header a])
-> (Program a -> [Header a] -> Program a)
-> Lens (Program a) [Header a]
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Program a -> [Header a]
forall srcAnnot. Program srcAnnot -> [Header srcAnnot]
programHeaders (\Program a
s [Header a]
a -> Program a
s { programHeaders = a })

definitions :: Lens (Program a) [Definition a]
definitions :: forall a (f :: * -> *).
Functor f =>
([Definition a] -> f [Definition a]) -> Program a -> f (Program a)
definitions = (Program a -> [Definition a])
-> (Program a -> [Definition a] -> Program a)
-> Lens (Program a) [Definition a]
forall s a. (s -> a) -> (s -> a -> s) -> Lens s a
lens Program a -> [Definition a]
forall srcAnnot. Program srcAnnot -> [Definition srcAnnot]
programDefinitions (\Program a
s [Definition a]
a -> Program a
s { programDefinitions = a })