-- | Fairly straightforward AST encoding of the .proto grammar

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE RecordWildCards            #-}

module Proto3.Suite.DotProto.AST
  ( -- * Types
      MessageName(..)
    , FieldName(..)
    , PackageName(..)
    , DotProtoIdentifier(..)
    , DotProtoImport(..)
    , DotProtoImportQualifier(..)
    , DotProtoPackageSpec(..)
    , DotProtoOption(..)
    , DotProtoDefinition(..)
    , DotProtoMeta(..)
    , DotProto(..)
    , DotProtoValue(..)
    , DotProtoPrimType(..)
    , Packing(..)
    , Path(..), fakePath
    , DotProtoType(..)
    , DotProtoEnumValue
    , DotProtoEnumPart(..)
    , Streaming(..)
    , DotProtoServicePart(..)
    , RPCMethod(..)
    , DotProtoMessagePart(..)
    , DotProtoField(..)
    , DotProtoReservedField(..)
  ) where

import           Control.Applicative
import           Control.Monad
import           Data.Data                 (Data)
import           Data.Int                  (Int32)
import qualified Data.List.NonEmpty        as NE
import           Data.String               (IsString(..))
import           GHC.Generics              (Generic)
import           Numeric.Natural
import           Prelude                   hiding (FilePath)
import           Proto3.Wire.Types         (FieldNumber (..))
import           Test.QuickCheck
import           Test.QuickCheck.Instances ()
import           Turtle                    (FilePath)

-- | The name of a message
newtype MessageName = MessageName
  { MessageName -> String
getMessageName :: String }
  deriving (Typeable MessageName
DataType
Constr
Typeable MessageName
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> MessageName -> c MessageName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c MessageName)
-> (MessageName -> Constr)
-> (MessageName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c MessageName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c MessageName))
-> ((forall b. Data b => b -> b) -> MessageName -> MessageName)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> MessageName -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> MessageName -> r)
-> (forall u. (forall d. Data d => d -> u) -> MessageName -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> MessageName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> MessageName -> m MessageName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> MessageName -> m MessageName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> MessageName -> m MessageName)
-> Data MessageName
MessageName -> DataType
MessageName -> Constr
(forall b. Data b => b -> b) -> MessageName -> MessageName
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MessageName -> c MessageName
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MessageName
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) -> MessageName -> u
forall u. (forall d. Data d => d -> u) -> MessageName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MessageName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MessageName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MessageName -> m MessageName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MessageName -> m MessageName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MessageName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MessageName -> c MessageName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MessageName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageName)
$cMessageName :: Constr
$tMessageName :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> MessageName -> m MessageName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MessageName -> m MessageName
gmapMp :: (forall d. Data d => d -> m d) -> MessageName -> m MessageName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MessageName -> m MessageName
gmapM :: (forall d. Data d => d -> m d) -> MessageName -> m MessageName
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MessageName -> m MessageName
gmapQi :: Int -> (forall d. Data d => d -> u) -> MessageName -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MessageName -> u
gmapQ :: (forall d. Data d => d -> u) -> MessageName -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> MessageName -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MessageName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MessageName -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MessageName -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MessageName -> r
gmapT :: (forall b. Data b => b -> b) -> MessageName -> MessageName
$cgmapT :: (forall b. Data b => b -> b) -> MessageName -> MessageName
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MessageName)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c MessageName)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MessageName)
dataTypeOf :: MessageName -> DataType
$cdataTypeOf :: MessageName -> DataType
toConstr :: MessageName -> Constr
$ctoConstr :: MessageName -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MessageName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MessageName
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MessageName -> c MessageName
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MessageName -> c MessageName
$cp1Data :: Typeable MessageName
Data, MessageName -> MessageName -> Bool
(MessageName -> MessageName -> Bool)
-> (MessageName -> MessageName -> Bool) -> Eq MessageName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MessageName -> MessageName -> Bool
$c/= :: MessageName -> MessageName -> Bool
== :: MessageName -> MessageName -> Bool
$c== :: MessageName -> MessageName -> Bool
Eq, (forall x. MessageName -> Rep MessageName x)
-> (forall x. Rep MessageName x -> MessageName)
-> Generic MessageName
forall x. Rep MessageName x -> MessageName
forall x. MessageName -> Rep MessageName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MessageName x -> MessageName
$cfrom :: forall x. MessageName -> Rep MessageName x
Generic, String -> MessageName
(String -> MessageName) -> IsString MessageName
forall a. (String -> a) -> IsString a
fromString :: String -> MessageName
$cfromString :: String -> MessageName
IsString, Eq MessageName
Eq MessageName
-> (MessageName -> MessageName -> Ordering)
-> (MessageName -> MessageName -> Bool)
-> (MessageName -> MessageName -> Bool)
-> (MessageName -> MessageName -> Bool)
-> (MessageName -> MessageName -> Bool)
-> (MessageName -> MessageName -> MessageName)
-> (MessageName -> MessageName -> MessageName)
-> Ord MessageName
MessageName -> MessageName -> Bool
MessageName -> MessageName -> Ordering
MessageName -> MessageName -> MessageName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MessageName -> MessageName -> MessageName
$cmin :: MessageName -> MessageName -> MessageName
max :: MessageName -> MessageName -> MessageName
$cmax :: MessageName -> MessageName -> MessageName
>= :: MessageName -> MessageName -> Bool
$c>= :: MessageName -> MessageName -> Bool
> :: MessageName -> MessageName -> Bool
$c> :: MessageName -> MessageName -> Bool
<= :: MessageName -> MessageName -> Bool
$c<= :: MessageName -> MessageName -> Bool
< :: MessageName -> MessageName -> Bool
$c< :: MessageName -> MessageName -> Bool
compare :: MessageName -> MessageName -> Ordering
$ccompare :: MessageName -> MessageName -> Ordering
$cp1Ord :: Eq MessageName
Ord)

instance Show MessageName where
  show :: MessageName -> String
show = ShowS
forall a. Show a => a -> String
show ShowS -> (MessageName -> String) -> MessageName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MessageName -> String
getMessageName

-- | The name of some field
newtype FieldName = FieldName
  { FieldName -> String
getFieldName :: String } 
  deriving (Typeable FieldName
DataType
Constr
Typeable FieldName
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> FieldName -> c FieldName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FieldName)
-> (FieldName -> Constr)
-> (FieldName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c FieldName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FieldName))
-> ((forall b. Data b => b -> b) -> FieldName -> FieldName)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FieldName -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FieldName -> r)
-> (forall u. (forall d. Data d => d -> u) -> FieldName -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FieldName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> FieldName -> m FieldName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FieldName -> m FieldName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FieldName -> m FieldName)
-> Data FieldName
FieldName -> DataType
FieldName -> Constr
(forall b. Data b => b -> b) -> FieldName -> FieldName
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FieldName -> c FieldName
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FieldName
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) -> FieldName -> u
forall u. (forall d. Data d => d -> u) -> FieldName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FieldName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FieldName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FieldName -> m FieldName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FieldName -> m FieldName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FieldName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FieldName -> c FieldName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FieldName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FieldName)
$cFieldName :: Constr
$tFieldName :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> FieldName -> m FieldName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FieldName -> m FieldName
gmapMp :: (forall d. Data d => d -> m d) -> FieldName -> m FieldName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FieldName -> m FieldName
gmapM :: (forall d. Data d => d -> m d) -> FieldName -> m FieldName
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FieldName -> m FieldName
gmapQi :: Int -> (forall d. Data d => d -> u) -> FieldName -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FieldName -> u
gmapQ :: (forall d. Data d => d -> u) -> FieldName -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FieldName -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FieldName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FieldName -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FieldName -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FieldName -> r
gmapT :: (forall b. Data b => b -> b) -> FieldName -> FieldName
$cgmapT :: (forall b. Data b => b -> b) -> FieldName -> FieldName
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FieldName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FieldName)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c FieldName)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FieldName)
dataTypeOf :: FieldName -> DataType
$cdataTypeOf :: FieldName -> DataType
toConstr :: FieldName -> Constr
$ctoConstr :: FieldName -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FieldName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FieldName
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FieldName -> c FieldName
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FieldName -> c FieldName
$cp1Data :: Typeable FieldName
Data, FieldName -> FieldName -> Bool
(FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> Bool) -> Eq FieldName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldName -> FieldName -> Bool
$c/= :: FieldName -> FieldName -> Bool
== :: FieldName -> FieldName -> Bool
$c== :: FieldName -> FieldName -> Bool
Eq, (forall x. FieldName -> Rep FieldName x)
-> (forall x. Rep FieldName x -> FieldName) -> Generic FieldName
forall x. Rep FieldName x -> FieldName
forall x. FieldName -> Rep FieldName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FieldName x -> FieldName
$cfrom :: forall x. FieldName -> Rep FieldName x
Generic, String -> FieldName
(String -> FieldName) -> IsString FieldName
forall a. (String -> a) -> IsString a
fromString :: String -> FieldName
$cfromString :: String -> FieldName
IsString, Eq FieldName
Eq FieldName
-> (FieldName -> FieldName -> Ordering)
-> (FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> FieldName)
-> (FieldName -> FieldName -> FieldName)
-> Ord FieldName
FieldName -> FieldName -> Bool
FieldName -> FieldName -> Ordering
FieldName -> FieldName -> FieldName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FieldName -> FieldName -> FieldName
$cmin :: FieldName -> FieldName -> FieldName
max :: FieldName -> FieldName -> FieldName
$cmax :: FieldName -> FieldName -> FieldName
>= :: FieldName -> FieldName -> Bool
$c>= :: FieldName -> FieldName -> Bool
> :: FieldName -> FieldName -> Bool
$c> :: FieldName -> FieldName -> Bool
<= :: FieldName -> FieldName -> Bool
$c<= :: FieldName -> FieldName -> Bool
< :: FieldName -> FieldName -> Bool
$c< :: FieldName -> FieldName -> Bool
compare :: FieldName -> FieldName -> Ordering
$ccompare :: FieldName -> FieldName -> Ordering
$cp1Ord :: Eq FieldName
Ord)

instance Show FieldName where
  show :: FieldName -> String
show = ShowS
forall a. Show a => a -> String
show ShowS -> (FieldName -> String) -> FieldName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldName -> String
getFieldName

-- | The name of the package
newtype PackageName = PackageName
  { PackageName -> String
getPackageName :: String } 
  deriving (Typeable PackageName
DataType
Constr
Typeable PackageName
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> PackageName -> c PackageName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PackageName)
-> (PackageName -> Constr)
-> (PackageName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PackageName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c PackageName))
-> ((forall b. Data b => b -> b) -> PackageName -> PackageName)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> PackageName -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> PackageName -> r)
-> (forall u. (forall d. Data d => d -> u) -> PackageName -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PackageName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> PackageName -> m PackageName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PackageName -> m PackageName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PackageName -> m PackageName)
-> Data PackageName
PackageName -> DataType
PackageName -> Constr
(forall b. Data b => b -> b) -> PackageName -> PackageName
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PackageName -> c PackageName
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PackageName
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) -> PackageName -> u
forall u. (forall d. Data d => d -> u) -> PackageName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PackageName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PackageName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PackageName -> m PackageName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PackageName -> m PackageName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PackageName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PackageName -> c PackageName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PackageName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PackageName)
$cPackageName :: Constr
$tPackageName :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> PackageName -> m PackageName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PackageName -> m PackageName
gmapMp :: (forall d. Data d => d -> m d) -> PackageName -> m PackageName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PackageName -> m PackageName
gmapM :: (forall d. Data d => d -> m d) -> PackageName -> m PackageName
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PackageName -> m PackageName
gmapQi :: Int -> (forall d. Data d => d -> u) -> PackageName -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PackageName -> u
gmapQ :: (forall d. Data d => d -> u) -> PackageName -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PackageName -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PackageName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PackageName -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PackageName -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PackageName -> r
gmapT :: (forall b. Data b => b -> b) -> PackageName -> PackageName
$cgmapT :: (forall b. Data b => b -> b) -> PackageName -> PackageName
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PackageName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PackageName)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c PackageName)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PackageName)
dataTypeOf :: PackageName -> DataType
$cdataTypeOf :: PackageName -> DataType
toConstr :: PackageName -> Constr
$ctoConstr :: PackageName -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PackageName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PackageName
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PackageName -> c PackageName
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PackageName -> c PackageName
$cp1Data :: Typeable PackageName
Data, PackageName -> PackageName -> Bool
(PackageName -> PackageName -> Bool)
-> (PackageName -> PackageName -> Bool) -> Eq PackageName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageName -> PackageName -> Bool
$c/= :: PackageName -> PackageName -> Bool
== :: PackageName -> PackageName -> Bool
$c== :: PackageName -> PackageName -> Bool
Eq, (forall x. PackageName -> Rep PackageName x)
-> (forall x. Rep PackageName x -> PackageName)
-> Generic PackageName
forall x. Rep PackageName x -> PackageName
forall x. PackageName -> Rep PackageName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PackageName x -> PackageName
$cfrom :: forall x. PackageName -> Rep PackageName x
Generic, String -> PackageName
(String -> PackageName) -> IsString PackageName
forall a. (String -> a) -> IsString a
fromString :: String -> PackageName
$cfromString :: String -> PackageName
IsString, Eq PackageName
Eq PackageName
-> (PackageName -> PackageName -> Ordering)
-> (PackageName -> PackageName -> Bool)
-> (PackageName -> PackageName -> Bool)
-> (PackageName -> PackageName -> Bool)
-> (PackageName -> PackageName -> Bool)
-> (PackageName -> PackageName -> PackageName)
-> (PackageName -> PackageName -> PackageName)
-> Ord PackageName
PackageName -> PackageName -> Bool
PackageName -> PackageName -> Ordering
PackageName -> PackageName -> PackageName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PackageName -> PackageName -> PackageName
$cmin :: PackageName -> PackageName -> PackageName
max :: PackageName -> PackageName -> PackageName
$cmax :: PackageName -> PackageName -> PackageName
>= :: PackageName -> PackageName -> Bool
$c>= :: PackageName -> PackageName -> Bool
> :: PackageName -> PackageName -> Bool
$c> :: PackageName -> PackageName -> Bool
<= :: PackageName -> PackageName -> Bool
$c<= :: PackageName -> PackageName -> Bool
< :: PackageName -> PackageName -> Bool
$c< :: PackageName -> PackageName -> Bool
compare :: PackageName -> PackageName -> Ordering
$ccompare :: PackageName -> PackageName -> Ordering
$cp1Ord :: Eq PackageName
Ord)

instance Show PackageName where
  show :: PackageName -> String
show = ShowS
forall a. Show a => a -> String
show ShowS -> (PackageName -> String) -> PackageName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> String
getPackageName

newtype Path = Path 
  { Path -> NonEmpty String
components :: NE.NonEmpty String } 
  deriving (Typeable Path
DataType
Constr
Typeable Path
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Path -> c Path)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Path)
-> (Path -> Constr)
-> (Path -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Path))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Path))
-> ((forall b. Data b => b -> b) -> Path -> Path)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Path -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Path -> r)
-> (forall u. (forall d. Data d => d -> u) -> Path -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Path -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Path -> m Path)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Path -> m Path)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Path -> m Path)
-> Data Path
Path -> DataType
Path -> Constr
(forall b. Data b => b -> b) -> Path -> Path
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Path -> c Path
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Path
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) -> Path -> u
forall u. (forall d. Data d => d -> u) -> Path -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Path -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Path -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Path -> m Path
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Path -> m Path
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Path
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Path -> c Path
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Path)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Path)
$cPath :: Constr
$tPath :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Path -> m Path
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Path -> m Path
gmapMp :: (forall d. Data d => d -> m d) -> Path -> m Path
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Path -> m Path
gmapM :: (forall d. Data d => d -> m d) -> Path -> m Path
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Path -> m Path
gmapQi :: Int -> (forall d. Data d => d -> u) -> Path -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Path -> u
gmapQ :: (forall d. Data d => d -> u) -> Path -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Path -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Path -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Path -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Path -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Path -> r
gmapT :: (forall b. Data b => b -> b) -> Path -> Path
$cgmapT :: (forall b. Data b => b -> b) -> Path -> Path
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Path)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Path)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Path)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Path)
dataTypeOf :: Path -> DataType
$cdataTypeOf :: Path -> DataType
toConstr :: Path -> Constr
$ctoConstr :: Path -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Path
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Path
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Path -> c Path
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Path -> c Path
$cp1Data :: Typeable Path
Data, Path -> Path -> Bool
(Path -> Path -> Bool) -> (Path -> Path -> Bool) -> Eq Path
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c== :: Path -> Path -> Bool
Eq, (forall x. Path -> Rep Path x)
-> (forall x. Rep Path x -> Path) -> Generic Path
forall x. Rep Path x -> Path
forall x. Path -> Rep Path x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Path x -> Path
$cfrom :: forall x. Path -> Rep Path x
Generic, Eq Path
Eq Path
-> (Path -> Path -> Ordering)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Path)
-> (Path -> Path -> Path)
-> Ord Path
Path -> Path -> Bool
Path -> Path -> Ordering
Path -> Path -> Path
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Path -> Path -> Path
$cmin :: Path -> Path -> Path
max :: Path -> Path -> Path
$cmax :: Path -> Path -> Path
>= :: Path -> Path -> Bool
$c>= :: Path -> Path -> Bool
> :: Path -> Path -> Bool
$c> :: Path -> Path -> Bool
<= :: Path -> Path -> Bool
$c<= :: Path -> Path -> Bool
< :: Path -> Path -> Bool
$c< :: Path -> Path -> Bool
compare :: Path -> Path -> Ordering
$ccompare :: Path -> Path -> Ordering
$cp1Ord :: Eq Path
Ord, Int -> Path -> ShowS
[Path] -> ShowS
Path -> String
(Int -> Path -> ShowS)
-> (Path -> String) -> ([Path] -> ShowS) -> Show Path
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Path] -> ShowS
$cshowList :: [Path] -> ShowS
show :: Path -> String
$cshow :: Path -> String
showsPrec :: Int -> Path -> ShowS
$cshowsPrec :: Int -> Path -> ShowS
Show)

-- Used for testing
fakePath :: Path
fakePath :: Path
fakePath = NonEmpty String -> Path
Path (String
"fakePath" String -> [String] -> NonEmpty String
forall a. a -> [a] -> NonEmpty a
NE.:| [])

data DotProtoIdentifier
  = Single String
  | Dots   Path
  | Qualified DotProtoIdentifier DotProtoIdentifier
  | Anonymous -- [recheck] is there a better way to represent unnamed things
  deriving (Typeable DotProtoIdentifier
DataType
Constr
Typeable DotProtoIdentifier
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> DotProtoIdentifier
    -> c DotProtoIdentifier)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DotProtoIdentifier)
-> (DotProtoIdentifier -> Constr)
-> (DotProtoIdentifier -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DotProtoIdentifier))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DotProtoIdentifier))
-> ((forall b. Data b => b -> b)
    -> DotProtoIdentifier -> DotProtoIdentifier)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DotProtoIdentifier -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DotProtoIdentifier -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> DotProtoIdentifier -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DotProtoIdentifier -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DotProtoIdentifier -> m DotProtoIdentifier)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DotProtoIdentifier -> m DotProtoIdentifier)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DotProtoIdentifier -> m DotProtoIdentifier)
-> Data DotProtoIdentifier
DotProtoIdentifier -> DataType
DotProtoIdentifier -> Constr
(forall b. Data b => b -> b)
-> DotProtoIdentifier -> DotProtoIdentifier
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DotProtoIdentifier
-> c DotProtoIdentifier
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoIdentifier
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) -> DotProtoIdentifier -> u
forall u. (forall d. Data d => d -> u) -> DotProtoIdentifier -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoIdentifier -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoIdentifier -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DotProtoIdentifier -> m DotProtoIdentifier
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DotProtoIdentifier -> m DotProtoIdentifier
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoIdentifier
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DotProtoIdentifier
-> c DotProtoIdentifier
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DotProtoIdentifier)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoIdentifier)
$cAnonymous :: Constr
$cQualified :: Constr
$cDots :: Constr
$cSingle :: Constr
$tDotProtoIdentifier :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> DotProtoIdentifier -> m DotProtoIdentifier
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DotProtoIdentifier -> m DotProtoIdentifier
gmapMp :: (forall d. Data d => d -> m d)
-> DotProtoIdentifier -> m DotProtoIdentifier
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DotProtoIdentifier -> m DotProtoIdentifier
gmapM :: (forall d. Data d => d -> m d)
-> DotProtoIdentifier -> m DotProtoIdentifier
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DotProtoIdentifier -> m DotProtoIdentifier
gmapQi :: Int -> (forall d. Data d => d -> u) -> DotProtoIdentifier -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DotProtoIdentifier -> u
gmapQ :: (forall d. Data d => d -> u) -> DotProtoIdentifier -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DotProtoIdentifier -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoIdentifier -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoIdentifier -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoIdentifier -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoIdentifier -> r
gmapT :: (forall b. Data b => b -> b)
-> DotProtoIdentifier -> DotProtoIdentifier
$cgmapT :: (forall b. Data b => b -> b)
-> DotProtoIdentifier -> DotProtoIdentifier
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoIdentifier)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoIdentifier)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DotProtoIdentifier)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DotProtoIdentifier)
dataTypeOf :: DotProtoIdentifier -> DataType
$cdataTypeOf :: DotProtoIdentifier -> DataType
toConstr :: DotProtoIdentifier -> Constr
$ctoConstr :: DotProtoIdentifier -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoIdentifier
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoIdentifier
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DotProtoIdentifier
-> c DotProtoIdentifier
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DotProtoIdentifier
-> c DotProtoIdentifier
$cp1Data :: Typeable DotProtoIdentifier
Data, DotProtoIdentifier -> DotProtoIdentifier -> Bool
(DotProtoIdentifier -> DotProtoIdentifier -> Bool)
-> (DotProtoIdentifier -> DotProtoIdentifier -> Bool)
-> Eq DotProtoIdentifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DotProtoIdentifier -> DotProtoIdentifier -> Bool
$c/= :: DotProtoIdentifier -> DotProtoIdentifier -> Bool
== :: DotProtoIdentifier -> DotProtoIdentifier -> Bool
$c== :: DotProtoIdentifier -> DotProtoIdentifier -> Bool
Eq, (forall x. DotProtoIdentifier -> Rep DotProtoIdentifier x)
-> (forall x. Rep DotProtoIdentifier x -> DotProtoIdentifier)
-> Generic DotProtoIdentifier
forall x. Rep DotProtoIdentifier x -> DotProtoIdentifier
forall x. DotProtoIdentifier -> Rep DotProtoIdentifier x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DotProtoIdentifier x -> DotProtoIdentifier
$cfrom :: forall x. DotProtoIdentifier -> Rep DotProtoIdentifier x
Generic, Eq DotProtoIdentifier
Eq DotProtoIdentifier
-> (DotProtoIdentifier -> DotProtoIdentifier -> Ordering)
-> (DotProtoIdentifier -> DotProtoIdentifier -> Bool)
-> (DotProtoIdentifier -> DotProtoIdentifier -> Bool)
-> (DotProtoIdentifier -> DotProtoIdentifier -> Bool)
-> (DotProtoIdentifier -> DotProtoIdentifier -> Bool)
-> (DotProtoIdentifier -> DotProtoIdentifier -> DotProtoIdentifier)
-> (DotProtoIdentifier -> DotProtoIdentifier -> DotProtoIdentifier)
-> Ord DotProtoIdentifier
DotProtoIdentifier -> DotProtoIdentifier -> Bool
DotProtoIdentifier -> DotProtoIdentifier -> Ordering
DotProtoIdentifier -> DotProtoIdentifier -> DotProtoIdentifier
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DotProtoIdentifier -> DotProtoIdentifier -> DotProtoIdentifier
$cmin :: DotProtoIdentifier -> DotProtoIdentifier -> DotProtoIdentifier
max :: DotProtoIdentifier -> DotProtoIdentifier -> DotProtoIdentifier
$cmax :: DotProtoIdentifier -> DotProtoIdentifier -> DotProtoIdentifier
>= :: DotProtoIdentifier -> DotProtoIdentifier -> Bool
$c>= :: DotProtoIdentifier -> DotProtoIdentifier -> Bool
> :: DotProtoIdentifier -> DotProtoIdentifier -> Bool
$c> :: DotProtoIdentifier -> DotProtoIdentifier -> Bool
<= :: DotProtoIdentifier -> DotProtoIdentifier -> Bool
$c<= :: DotProtoIdentifier -> DotProtoIdentifier -> Bool
< :: DotProtoIdentifier -> DotProtoIdentifier -> Bool
$c< :: DotProtoIdentifier -> DotProtoIdentifier -> Bool
compare :: DotProtoIdentifier -> DotProtoIdentifier -> Ordering
$ccompare :: DotProtoIdentifier -> DotProtoIdentifier -> Ordering
$cp1Ord :: Eq DotProtoIdentifier
Ord, Int -> DotProtoIdentifier -> ShowS
[DotProtoIdentifier] -> ShowS
DotProtoIdentifier -> String
(Int -> DotProtoIdentifier -> ShowS)
-> (DotProtoIdentifier -> String)
-> ([DotProtoIdentifier] -> ShowS)
-> Show DotProtoIdentifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DotProtoIdentifier] -> ShowS
$cshowList :: [DotProtoIdentifier] -> ShowS
show :: DotProtoIdentifier -> String
$cshow :: DotProtoIdentifier -> String
showsPrec :: Int -> DotProtoIdentifier -> ShowS
$cshowsPrec :: Int -> DotProtoIdentifier -> ShowS
Show)

-- | Top-level import declaration
data DotProtoImport = DotProtoImport
  { DotProtoImport -> DotProtoImportQualifier
dotProtoImportQualifier :: DotProtoImportQualifier
  , DotProtoImport -> String
dotProtoImportPath      :: FilePath
  } 
  deriving (Typeable DotProtoImport
DataType
Constr
Typeable DotProtoImport
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DotProtoImport -> c DotProtoImport)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DotProtoImport)
-> (DotProtoImport -> Constr)
-> (DotProtoImport -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DotProtoImport))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DotProtoImport))
-> ((forall b. Data b => b -> b)
    -> DotProtoImport -> DotProtoImport)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DotProtoImport -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DotProtoImport -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> DotProtoImport -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DotProtoImport -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DotProtoImport -> m DotProtoImport)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DotProtoImport -> m DotProtoImport)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DotProtoImport -> m DotProtoImport)
-> Data DotProtoImport
DotProtoImport -> DataType
DotProtoImport -> Constr
(forall b. Data b => b -> b) -> DotProtoImport -> DotProtoImport
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProtoImport -> c DotProtoImport
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoImport
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) -> DotProtoImport -> u
forall u. (forall d. Data d => d -> u) -> DotProtoImport -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoImport -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoImport -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DotProtoImport -> m DotProtoImport
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DotProtoImport -> m DotProtoImport
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoImport
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProtoImport -> c DotProtoImport
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DotProtoImport)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoImport)
$cDotProtoImport :: Constr
$tDotProtoImport :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> DotProtoImport -> m DotProtoImport
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DotProtoImport -> m DotProtoImport
gmapMp :: (forall d. Data d => d -> m d)
-> DotProtoImport -> m DotProtoImport
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DotProtoImport -> m DotProtoImport
gmapM :: (forall d. Data d => d -> m d)
-> DotProtoImport -> m DotProtoImport
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DotProtoImport -> m DotProtoImport
gmapQi :: Int -> (forall d. Data d => d -> u) -> DotProtoImport -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DotProtoImport -> u
gmapQ :: (forall d. Data d => d -> u) -> DotProtoImport -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DotProtoImport -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoImport -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoImport -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoImport -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoImport -> r
gmapT :: (forall b. Data b => b -> b) -> DotProtoImport -> DotProtoImport
$cgmapT :: (forall b. Data b => b -> b) -> DotProtoImport -> DotProtoImport
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoImport)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoImport)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DotProtoImport)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DotProtoImport)
dataTypeOf :: DotProtoImport -> DataType
$cdataTypeOf :: DotProtoImport -> DataType
toConstr :: DotProtoImport -> Constr
$ctoConstr :: DotProtoImport -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoImport
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoImport
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProtoImport -> c DotProtoImport
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProtoImport -> c DotProtoImport
$cp1Data :: Typeable DotProtoImport
Data, DotProtoImport -> DotProtoImport -> Bool
(DotProtoImport -> DotProtoImport -> Bool)
-> (DotProtoImport -> DotProtoImport -> Bool) -> Eq DotProtoImport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DotProtoImport -> DotProtoImport -> Bool
$c/= :: DotProtoImport -> DotProtoImport -> Bool
== :: DotProtoImport -> DotProtoImport -> Bool
$c== :: DotProtoImport -> DotProtoImport -> Bool
Eq, (forall x. DotProtoImport -> Rep DotProtoImport x)
-> (forall x. Rep DotProtoImport x -> DotProtoImport)
-> Generic DotProtoImport
forall x. Rep DotProtoImport x -> DotProtoImport
forall x. DotProtoImport -> Rep DotProtoImport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DotProtoImport x -> DotProtoImport
$cfrom :: forall x. DotProtoImport -> Rep DotProtoImport x
Generic, Eq DotProtoImport
Eq DotProtoImport
-> (DotProtoImport -> DotProtoImport -> Ordering)
-> (DotProtoImport -> DotProtoImport -> Bool)
-> (DotProtoImport -> DotProtoImport -> Bool)
-> (DotProtoImport -> DotProtoImport -> Bool)
-> (DotProtoImport -> DotProtoImport -> Bool)
-> (DotProtoImport -> DotProtoImport -> DotProtoImport)
-> (DotProtoImport -> DotProtoImport -> DotProtoImport)
-> Ord DotProtoImport
DotProtoImport -> DotProtoImport -> Bool
DotProtoImport -> DotProtoImport -> Ordering
DotProtoImport -> DotProtoImport -> DotProtoImport
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DotProtoImport -> DotProtoImport -> DotProtoImport
$cmin :: DotProtoImport -> DotProtoImport -> DotProtoImport
max :: DotProtoImport -> DotProtoImport -> DotProtoImport
$cmax :: DotProtoImport -> DotProtoImport -> DotProtoImport
>= :: DotProtoImport -> DotProtoImport -> Bool
$c>= :: DotProtoImport -> DotProtoImport -> Bool
> :: DotProtoImport -> DotProtoImport -> Bool
$c> :: DotProtoImport -> DotProtoImport -> Bool
<= :: DotProtoImport -> DotProtoImport -> Bool
$c<= :: DotProtoImport -> DotProtoImport -> Bool
< :: DotProtoImport -> DotProtoImport -> Bool
$c< :: DotProtoImport -> DotProtoImport -> Bool
compare :: DotProtoImport -> DotProtoImport -> Ordering
$ccompare :: DotProtoImport -> DotProtoImport -> Ordering
$cp1Ord :: Eq DotProtoImport
Ord, Int -> DotProtoImport -> ShowS
[DotProtoImport] -> ShowS
DotProtoImport -> String
(Int -> DotProtoImport -> ShowS)
-> (DotProtoImport -> String)
-> ([DotProtoImport] -> ShowS)
-> Show DotProtoImport
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DotProtoImport] -> ShowS
$cshowList :: [DotProtoImport] -> ShowS
show :: DotProtoImport -> String
$cshow :: DotProtoImport -> String
showsPrec :: Int -> DotProtoImport -> ShowS
$cshowsPrec :: Int -> DotProtoImport -> ShowS
Show)

instance Arbitrary DotProtoImport where
  arbitrary :: Gen DotProtoImport
arbitrary = do
    DotProtoImportQualifier
dotProtoImportQualifier <- Gen DotProtoImportQualifier
forall a. Arbitrary a => Gen a
arbitrary
    String
dotProtoImportPath <- ShowS -> Gen String -> Gen String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShowS
forall a. IsString a => String -> a
fromString Gen String
forall a. Arbitrary a => Gen a
arbitrary
    DotProtoImport -> Gen DotProtoImport
forall (m :: * -> *) a. Monad m => a -> m a
return (DotProtoImport :: DotProtoImportQualifier -> String -> DotProtoImport
DotProtoImport {String
DotProtoImportQualifier
dotProtoImportPath :: String
dotProtoImportQualifier :: DotProtoImportQualifier
dotProtoImportPath :: String
dotProtoImportQualifier :: DotProtoImportQualifier
..})

data DotProtoImportQualifier
  = DotProtoImportPublic
  | DotProtoImportWeak
  | DotProtoImportDefault
  deriving (DotProtoImportQualifier
DotProtoImportQualifier
-> DotProtoImportQualifier -> Bounded DotProtoImportQualifier
forall a. a -> a -> Bounded a
maxBound :: DotProtoImportQualifier
$cmaxBound :: DotProtoImportQualifier
minBound :: DotProtoImportQualifier
$cminBound :: DotProtoImportQualifier
Bounded, Typeable DotProtoImportQualifier
DataType
Constr
Typeable DotProtoImportQualifier
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> DotProtoImportQualifier
    -> c DotProtoImportQualifier)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DotProtoImportQualifier)
-> (DotProtoImportQualifier -> Constr)
-> (DotProtoImportQualifier -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DotProtoImportQualifier))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DotProtoImportQualifier))
-> ((forall b. Data b => b -> b)
    -> DotProtoImportQualifier -> DotProtoImportQualifier)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> DotProtoImportQualifier
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> DotProtoImportQualifier
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> DotProtoImportQualifier -> [u])
-> (forall u.
    Int
    -> (forall d. Data d => d -> u) -> DotProtoImportQualifier -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DotProtoImportQualifier -> m DotProtoImportQualifier)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DotProtoImportQualifier -> m DotProtoImportQualifier)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DotProtoImportQualifier -> m DotProtoImportQualifier)
-> Data DotProtoImportQualifier
DotProtoImportQualifier -> DataType
DotProtoImportQualifier -> Constr
(forall b. Data b => b -> b)
-> DotProtoImportQualifier -> DotProtoImportQualifier
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DotProtoImportQualifier
-> c DotProtoImportQualifier
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoImportQualifier
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) -> DotProtoImportQualifier -> u
forall u.
(forall d. Data d => d -> u) -> DotProtoImportQualifier -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> DotProtoImportQualifier
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> DotProtoImportQualifier
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DotProtoImportQualifier -> m DotProtoImportQualifier
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DotProtoImportQualifier -> m DotProtoImportQualifier
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoImportQualifier
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DotProtoImportQualifier
-> c DotProtoImportQualifier
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DotProtoImportQualifier)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoImportQualifier)
$cDotProtoImportDefault :: Constr
$cDotProtoImportWeak :: Constr
$cDotProtoImportPublic :: Constr
$tDotProtoImportQualifier :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> DotProtoImportQualifier -> m DotProtoImportQualifier
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DotProtoImportQualifier -> m DotProtoImportQualifier
gmapMp :: (forall d. Data d => d -> m d)
-> DotProtoImportQualifier -> m DotProtoImportQualifier
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DotProtoImportQualifier -> m DotProtoImportQualifier
gmapM :: (forall d. Data d => d -> m d)
-> DotProtoImportQualifier -> m DotProtoImportQualifier
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DotProtoImportQualifier -> m DotProtoImportQualifier
gmapQi :: Int -> (forall d. Data d => d -> u) -> DotProtoImportQualifier -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DotProtoImportQualifier -> u
gmapQ :: (forall d. Data d => d -> u) -> DotProtoImportQualifier -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> DotProtoImportQualifier -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> DotProtoImportQualifier
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> DotProtoImportQualifier
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> DotProtoImportQualifier
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> DotProtoImportQualifier
-> r
gmapT :: (forall b. Data b => b -> b)
-> DotProtoImportQualifier -> DotProtoImportQualifier
$cgmapT :: (forall b. Data b => b -> b)
-> DotProtoImportQualifier -> DotProtoImportQualifier
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoImportQualifier)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoImportQualifier)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DotProtoImportQualifier)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DotProtoImportQualifier)
dataTypeOf :: DotProtoImportQualifier -> DataType
$cdataTypeOf :: DotProtoImportQualifier -> DataType
toConstr :: DotProtoImportQualifier -> Constr
$ctoConstr :: DotProtoImportQualifier -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoImportQualifier
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoImportQualifier
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DotProtoImportQualifier
-> c DotProtoImportQualifier
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DotProtoImportQualifier
-> c DotProtoImportQualifier
$cp1Data :: Typeable DotProtoImportQualifier
Data, Int -> DotProtoImportQualifier
DotProtoImportQualifier -> Int
DotProtoImportQualifier -> [DotProtoImportQualifier]
DotProtoImportQualifier -> DotProtoImportQualifier
DotProtoImportQualifier
-> DotProtoImportQualifier -> [DotProtoImportQualifier]
DotProtoImportQualifier
-> DotProtoImportQualifier
-> DotProtoImportQualifier
-> [DotProtoImportQualifier]
(DotProtoImportQualifier -> DotProtoImportQualifier)
-> (DotProtoImportQualifier -> DotProtoImportQualifier)
-> (Int -> DotProtoImportQualifier)
-> (DotProtoImportQualifier -> Int)
-> (DotProtoImportQualifier -> [DotProtoImportQualifier])
-> (DotProtoImportQualifier
    -> DotProtoImportQualifier -> [DotProtoImportQualifier])
-> (DotProtoImportQualifier
    -> DotProtoImportQualifier -> [DotProtoImportQualifier])
-> (DotProtoImportQualifier
    -> DotProtoImportQualifier
    -> DotProtoImportQualifier
    -> [DotProtoImportQualifier])
-> Enum DotProtoImportQualifier
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: DotProtoImportQualifier
-> DotProtoImportQualifier
-> DotProtoImportQualifier
-> [DotProtoImportQualifier]
$cenumFromThenTo :: DotProtoImportQualifier
-> DotProtoImportQualifier
-> DotProtoImportQualifier
-> [DotProtoImportQualifier]
enumFromTo :: DotProtoImportQualifier
-> DotProtoImportQualifier -> [DotProtoImportQualifier]
$cenumFromTo :: DotProtoImportQualifier
-> DotProtoImportQualifier -> [DotProtoImportQualifier]
enumFromThen :: DotProtoImportQualifier
-> DotProtoImportQualifier -> [DotProtoImportQualifier]
$cenumFromThen :: DotProtoImportQualifier
-> DotProtoImportQualifier -> [DotProtoImportQualifier]
enumFrom :: DotProtoImportQualifier -> [DotProtoImportQualifier]
$cenumFrom :: DotProtoImportQualifier -> [DotProtoImportQualifier]
fromEnum :: DotProtoImportQualifier -> Int
$cfromEnum :: DotProtoImportQualifier -> Int
toEnum :: Int -> DotProtoImportQualifier
$ctoEnum :: Int -> DotProtoImportQualifier
pred :: DotProtoImportQualifier -> DotProtoImportQualifier
$cpred :: DotProtoImportQualifier -> DotProtoImportQualifier
succ :: DotProtoImportQualifier -> DotProtoImportQualifier
$csucc :: DotProtoImportQualifier -> DotProtoImportQualifier
Enum, DotProtoImportQualifier -> DotProtoImportQualifier -> Bool
(DotProtoImportQualifier -> DotProtoImportQualifier -> Bool)
-> (DotProtoImportQualifier -> DotProtoImportQualifier -> Bool)
-> Eq DotProtoImportQualifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DotProtoImportQualifier -> DotProtoImportQualifier -> Bool
$c/= :: DotProtoImportQualifier -> DotProtoImportQualifier -> Bool
== :: DotProtoImportQualifier -> DotProtoImportQualifier -> Bool
$c== :: DotProtoImportQualifier -> DotProtoImportQualifier -> Bool
Eq, (forall x.
 DotProtoImportQualifier -> Rep DotProtoImportQualifier x)
-> (forall x.
    Rep DotProtoImportQualifier x -> DotProtoImportQualifier)
-> Generic DotProtoImportQualifier
forall x. Rep DotProtoImportQualifier x -> DotProtoImportQualifier
forall x. DotProtoImportQualifier -> Rep DotProtoImportQualifier x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DotProtoImportQualifier x -> DotProtoImportQualifier
$cfrom :: forall x. DotProtoImportQualifier -> Rep DotProtoImportQualifier x
Generic, Eq DotProtoImportQualifier
Eq DotProtoImportQualifier
-> (DotProtoImportQualifier -> DotProtoImportQualifier -> Ordering)
-> (DotProtoImportQualifier -> DotProtoImportQualifier -> Bool)
-> (DotProtoImportQualifier -> DotProtoImportQualifier -> Bool)
-> (DotProtoImportQualifier -> DotProtoImportQualifier -> Bool)
-> (DotProtoImportQualifier -> DotProtoImportQualifier -> Bool)
-> (DotProtoImportQualifier
    -> DotProtoImportQualifier -> DotProtoImportQualifier)
-> (DotProtoImportQualifier
    -> DotProtoImportQualifier -> DotProtoImportQualifier)
-> Ord DotProtoImportQualifier
DotProtoImportQualifier -> DotProtoImportQualifier -> Bool
DotProtoImportQualifier -> DotProtoImportQualifier -> Ordering
DotProtoImportQualifier
-> DotProtoImportQualifier -> DotProtoImportQualifier
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DotProtoImportQualifier
-> DotProtoImportQualifier -> DotProtoImportQualifier
$cmin :: DotProtoImportQualifier
-> DotProtoImportQualifier -> DotProtoImportQualifier
max :: DotProtoImportQualifier
-> DotProtoImportQualifier -> DotProtoImportQualifier
$cmax :: DotProtoImportQualifier
-> DotProtoImportQualifier -> DotProtoImportQualifier
>= :: DotProtoImportQualifier -> DotProtoImportQualifier -> Bool
$c>= :: DotProtoImportQualifier -> DotProtoImportQualifier -> Bool
> :: DotProtoImportQualifier -> DotProtoImportQualifier -> Bool
$c> :: DotProtoImportQualifier -> DotProtoImportQualifier -> Bool
<= :: DotProtoImportQualifier -> DotProtoImportQualifier -> Bool
$c<= :: DotProtoImportQualifier -> DotProtoImportQualifier -> Bool
< :: DotProtoImportQualifier -> DotProtoImportQualifier -> Bool
$c< :: DotProtoImportQualifier -> DotProtoImportQualifier -> Bool
compare :: DotProtoImportQualifier -> DotProtoImportQualifier -> Ordering
$ccompare :: DotProtoImportQualifier -> DotProtoImportQualifier -> Ordering
$cp1Ord :: Eq DotProtoImportQualifier
Ord, Int -> DotProtoImportQualifier -> ShowS
[DotProtoImportQualifier] -> ShowS
DotProtoImportQualifier -> String
(Int -> DotProtoImportQualifier -> ShowS)
-> (DotProtoImportQualifier -> String)
-> ([DotProtoImportQualifier] -> ShowS)
-> Show DotProtoImportQualifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DotProtoImportQualifier] -> ShowS
$cshowList :: [DotProtoImportQualifier] -> ShowS
show :: DotProtoImportQualifier -> String
$cshow :: DotProtoImportQualifier -> String
showsPrec :: Int -> DotProtoImportQualifier -> ShowS
$cshowsPrec :: Int -> DotProtoImportQualifier -> ShowS
Show)

instance Arbitrary DotProtoImportQualifier where
  arbitrary :: Gen DotProtoImportQualifier
arbitrary = [DotProtoImportQualifier] -> Gen DotProtoImportQualifier
forall a. [a] -> Gen a
elements
    [ DotProtoImportQualifier
DotProtoImportDefault
    , DotProtoImportQualifier
DotProtoImportWeak
    , DotProtoImportQualifier
DotProtoImportPublic
    ]

-- | The namespace declaration
data DotProtoPackageSpec
  = DotProtoPackageSpec DotProtoIdentifier
  | DotProtoNoPackage
  deriving (Typeable DotProtoPackageSpec
DataType
Constr
Typeable DotProtoPackageSpec
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> DotProtoPackageSpec
    -> c DotProtoPackageSpec)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DotProtoPackageSpec)
-> (DotProtoPackageSpec -> Constr)
-> (DotProtoPackageSpec -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DotProtoPackageSpec))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DotProtoPackageSpec))
-> ((forall b. Data b => b -> b)
    -> DotProtoPackageSpec -> DotProtoPackageSpec)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DotProtoPackageSpec -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DotProtoPackageSpec -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> DotProtoPackageSpec -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DotProtoPackageSpec -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DotProtoPackageSpec -> m DotProtoPackageSpec)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DotProtoPackageSpec -> m DotProtoPackageSpec)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DotProtoPackageSpec -> m DotProtoPackageSpec)
-> Data DotProtoPackageSpec
DotProtoPackageSpec -> DataType
DotProtoPackageSpec -> Constr
(forall b. Data b => b -> b)
-> DotProtoPackageSpec -> DotProtoPackageSpec
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DotProtoPackageSpec
-> c DotProtoPackageSpec
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoPackageSpec
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) -> DotProtoPackageSpec -> u
forall u.
(forall d. Data d => d -> u) -> DotProtoPackageSpec -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoPackageSpec -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoPackageSpec -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DotProtoPackageSpec -> m DotProtoPackageSpec
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DotProtoPackageSpec -> m DotProtoPackageSpec
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoPackageSpec
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DotProtoPackageSpec
-> c DotProtoPackageSpec
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DotProtoPackageSpec)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoPackageSpec)
$cDotProtoNoPackage :: Constr
$cDotProtoPackageSpec :: Constr
$tDotProtoPackageSpec :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> DotProtoPackageSpec -> m DotProtoPackageSpec
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DotProtoPackageSpec -> m DotProtoPackageSpec
gmapMp :: (forall d. Data d => d -> m d)
-> DotProtoPackageSpec -> m DotProtoPackageSpec
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DotProtoPackageSpec -> m DotProtoPackageSpec
gmapM :: (forall d. Data d => d -> m d)
-> DotProtoPackageSpec -> m DotProtoPackageSpec
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DotProtoPackageSpec -> m DotProtoPackageSpec
gmapQi :: Int -> (forall d. Data d => d -> u) -> DotProtoPackageSpec -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DotProtoPackageSpec -> u
gmapQ :: (forall d. Data d => d -> u) -> DotProtoPackageSpec -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> DotProtoPackageSpec -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoPackageSpec -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoPackageSpec -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoPackageSpec -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoPackageSpec -> r
gmapT :: (forall b. Data b => b -> b)
-> DotProtoPackageSpec -> DotProtoPackageSpec
$cgmapT :: (forall b. Data b => b -> b)
-> DotProtoPackageSpec -> DotProtoPackageSpec
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoPackageSpec)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoPackageSpec)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DotProtoPackageSpec)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DotProtoPackageSpec)
dataTypeOf :: DotProtoPackageSpec -> DataType
$cdataTypeOf :: DotProtoPackageSpec -> DataType
toConstr :: DotProtoPackageSpec -> Constr
$ctoConstr :: DotProtoPackageSpec -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoPackageSpec
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoPackageSpec
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DotProtoPackageSpec
-> c DotProtoPackageSpec
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DotProtoPackageSpec
-> c DotProtoPackageSpec
$cp1Data :: Typeable DotProtoPackageSpec
Data, DotProtoPackageSpec -> DotProtoPackageSpec -> Bool
(DotProtoPackageSpec -> DotProtoPackageSpec -> Bool)
-> (DotProtoPackageSpec -> DotProtoPackageSpec -> Bool)
-> Eq DotProtoPackageSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DotProtoPackageSpec -> DotProtoPackageSpec -> Bool
$c/= :: DotProtoPackageSpec -> DotProtoPackageSpec -> Bool
== :: DotProtoPackageSpec -> DotProtoPackageSpec -> Bool
$c== :: DotProtoPackageSpec -> DotProtoPackageSpec -> Bool
Eq, (forall x. DotProtoPackageSpec -> Rep DotProtoPackageSpec x)
-> (forall x. Rep DotProtoPackageSpec x -> DotProtoPackageSpec)
-> Generic DotProtoPackageSpec
forall x. Rep DotProtoPackageSpec x -> DotProtoPackageSpec
forall x. DotProtoPackageSpec -> Rep DotProtoPackageSpec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DotProtoPackageSpec x -> DotProtoPackageSpec
$cfrom :: forall x. DotProtoPackageSpec -> Rep DotProtoPackageSpec x
Generic, Eq DotProtoPackageSpec
Eq DotProtoPackageSpec
-> (DotProtoPackageSpec -> DotProtoPackageSpec -> Ordering)
-> (DotProtoPackageSpec -> DotProtoPackageSpec -> Bool)
-> (DotProtoPackageSpec -> DotProtoPackageSpec -> Bool)
-> (DotProtoPackageSpec -> DotProtoPackageSpec -> Bool)
-> (DotProtoPackageSpec -> DotProtoPackageSpec -> Bool)
-> (DotProtoPackageSpec
    -> DotProtoPackageSpec -> DotProtoPackageSpec)
-> (DotProtoPackageSpec
    -> DotProtoPackageSpec -> DotProtoPackageSpec)
-> Ord DotProtoPackageSpec
DotProtoPackageSpec -> DotProtoPackageSpec -> Bool
DotProtoPackageSpec -> DotProtoPackageSpec -> Ordering
DotProtoPackageSpec -> DotProtoPackageSpec -> DotProtoPackageSpec
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DotProtoPackageSpec -> DotProtoPackageSpec -> DotProtoPackageSpec
$cmin :: DotProtoPackageSpec -> DotProtoPackageSpec -> DotProtoPackageSpec
max :: DotProtoPackageSpec -> DotProtoPackageSpec -> DotProtoPackageSpec
$cmax :: DotProtoPackageSpec -> DotProtoPackageSpec -> DotProtoPackageSpec
>= :: DotProtoPackageSpec -> DotProtoPackageSpec -> Bool
$c>= :: DotProtoPackageSpec -> DotProtoPackageSpec -> Bool
> :: DotProtoPackageSpec -> DotProtoPackageSpec -> Bool
$c> :: DotProtoPackageSpec -> DotProtoPackageSpec -> Bool
<= :: DotProtoPackageSpec -> DotProtoPackageSpec -> Bool
$c<= :: DotProtoPackageSpec -> DotProtoPackageSpec -> Bool
< :: DotProtoPackageSpec -> DotProtoPackageSpec -> Bool
$c< :: DotProtoPackageSpec -> DotProtoPackageSpec -> Bool
compare :: DotProtoPackageSpec -> DotProtoPackageSpec -> Ordering
$ccompare :: DotProtoPackageSpec -> DotProtoPackageSpec -> Ordering
$cp1Ord :: Eq DotProtoPackageSpec
Ord, Int -> DotProtoPackageSpec -> ShowS
[DotProtoPackageSpec] -> ShowS
DotProtoPackageSpec -> String
(Int -> DotProtoPackageSpec -> ShowS)
-> (DotProtoPackageSpec -> String)
-> ([DotProtoPackageSpec] -> ShowS)
-> Show DotProtoPackageSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DotProtoPackageSpec] -> ShowS
$cshowList :: [DotProtoPackageSpec] -> ShowS
show :: DotProtoPackageSpec -> String
$cshow :: DotProtoPackageSpec -> String
showsPrec :: Int -> DotProtoPackageSpec -> ShowS
$cshowsPrec :: Int -> DotProtoPackageSpec -> ShowS
Show)

instance Arbitrary DotProtoPackageSpec where
  arbitrary :: Gen DotProtoPackageSpec
arbitrary = [Gen DotProtoPackageSpec] -> Gen DotProtoPackageSpec
forall a. [Gen a] -> Gen a
oneof
    [ DotProtoPackageSpec -> Gen DotProtoPackageSpec
forall (m :: * -> *) a. Monad m => a -> m a
return DotProtoPackageSpec
DotProtoNoPackage
    , (DotProtoIdentifier -> DotProtoPackageSpec)
-> Gen DotProtoIdentifier -> Gen DotProtoPackageSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DotProtoIdentifier -> DotProtoPackageSpec
DotProtoPackageSpec Gen DotProtoIdentifier
arbitrarySingleIdentifier
    , (DotProtoIdentifier -> DotProtoPackageSpec)
-> Gen DotProtoIdentifier -> Gen DotProtoPackageSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DotProtoIdentifier -> DotProtoPackageSpec
DotProtoPackageSpec Gen DotProtoIdentifier
arbitraryPathIdentifier
    ]

-- | An option id/value pair, can be attached to many types of statements
data DotProtoOption = DotProtoOption
  { DotProtoOption -> DotProtoIdentifier
dotProtoOptionIdentifier :: DotProtoIdentifier
  , DotProtoOption -> DotProtoValue
dotProtoOptionValue      :: DotProtoValue
  } deriving (Typeable DotProtoOption
DataType
Constr
Typeable DotProtoOption
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DotProtoOption -> c DotProtoOption)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DotProtoOption)
-> (DotProtoOption -> Constr)
-> (DotProtoOption -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DotProtoOption))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DotProtoOption))
-> ((forall b. Data b => b -> b)
    -> DotProtoOption -> DotProtoOption)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DotProtoOption -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DotProtoOption -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> DotProtoOption -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DotProtoOption -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DotProtoOption -> m DotProtoOption)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DotProtoOption -> m DotProtoOption)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DotProtoOption -> m DotProtoOption)
-> Data DotProtoOption
DotProtoOption -> DataType
DotProtoOption -> Constr
(forall b. Data b => b -> b) -> DotProtoOption -> DotProtoOption
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProtoOption -> c DotProtoOption
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoOption
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) -> DotProtoOption -> u
forall u. (forall d. Data d => d -> u) -> DotProtoOption -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoOption -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoOption -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DotProtoOption -> m DotProtoOption
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DotProtoOption -> m DotProtoOption
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoOption
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProtoOption -> c DotProtoOption
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DotProtoOption)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoOption)
$cDotProtoOption :: Constr
$tDotProtoOption :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> DotProtoOption -> m DotProtoOption
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DotProtoOption -> m DotProtoOption
gmapMp :: (forall d. Data d => d -> m d)
-> DotProtoOption -> m DotProtoOption
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DotProtoOption -> m DotProtoOption
gmapM :: (forall d. Data d => d -> m d)
-> DotProtoOption -> m DotProtoOption
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DotProtoOption -> m DotProtoOption
gmapQi :: Int -> (forall d. Data d => d -> u) -> DotProtoOption -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DotProtoOption -> u
gmapQ :: (forall d. Data d => d -> u) -> DotProtoOption -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DotProtoOption -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoOption -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoOption -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoOption -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoOption -> r
gmapT :: (forall b. Data b => b -> b) -> DotProtoOption -> DotProtoOption
$cgmapT :: (forall b. Data b => b -> b) -> DotProtoOption -> DotProtoOption
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoOption)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoOption)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DotProtoOption)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DotProtoOption)
dataTypeOf :: DotProtoOption -> DataType
$cdataTypeOf :: DotProtoOption -> DataType
toConstr :: DotProtoOption -> Constr
$ctoConstr :: DotProtoOption -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoOption
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoOption
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProtoOption -> c DotProtoOption
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProtoOption -> c DotProtoOption
$cp1Data :: Typeable DotProtoOption
Data, DotProtoOption -> DotProtoOption -> Bool
(DotProtoOption -> DotProtoOption -> Bool)
-> (DotProtoOption -> DotProtoOption -> Bool) -> Eq DotProtoOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DotProtoOption -> DotProtoOption -> Bool
$c/= :: DotProtoOption -> DotProtoOption -> Bool
== :: DotProtoOption -> DotProtoOption -> Bool
$c== :: DotProtoOption -> DotProtoOption -> Bool
Eq, (forall x. DotProtoOption -> Rep DotProtoOption x)
-> (forall x. Rep DotProtoOption x -> DotProtoOption)
-> Generic DotProtoOption
forall x. Rep DotProtoOption x -> DotProtoOption
forall x. DotProtoOption -> Rep DotProtoOption x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DotProtoOption x -> DotProtoOption
$cfrom :: forall x. DotProtoOption -> Rep DotProtoOption x
Generic, Eq DotProtoOption
Eq DotProtoOption
-> (DotProtoOption -> DotProtoOption -> Ordering)
-> (DotProtoOption -> DotProtoOption -> Bool)
-> (DotProtoOption -> DotProtoOption -> Bool)
-> (DotProtoOption -> DotProtoOption -> Bool)
-> (DotProtoOption -> DotProtoOption -> Bool)
-> (DotProtoOption -> DotProtoOption -> DotProtoOption)
-> (DotProtoOption -> DotProtoOption -> DotProtoOption)
-> Ord DotProtoOption
DotProtoOption -> DotProtoOption -> Bool
DotProtoOption -> DotProtoOption -> Ordering
DotProtoOption -> DotProtoOption -> DotProtoOption
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DotProtoOption -> DotProtoOption -> DotProtoOption
$cmin :: DotProtoOption -> DotProtoOption -> DotProtoOption
max :: DotProtoOption -> DotProtoOption -> DotProtoOption
$cmax :: DotProtoOption -> DotProtoOption -> DotProtoOption
>= :: DotProtoOption -> DotProtoOption -> Bool
$c>= :: DotProtoOption -> DotProtoOption -> Bool
> :: DotProtoOption -> DotProtoOption -> Bool
$c> :: DotProtoOption -> DotProtoOption -> Bool
<= :: DotProtoOption -> DotProtoOption -> Bool
$c<= :: DotProtoOption -> DotProtoOption -> Bool
< :: DotProtoOption -> DotProtoOption -> Bool
$c< :: DotProtoOption -> DotProtoOption -> Bool
compare :: DotProtoOption -> DotProtoOption -> Ordering
$ccompare :: DotProtoOption -> DotProtoOption -> Ordering
$cp1Ord :: Eq DotProtoOption
Ord, Int -> DotProtoOption -> ShowS
[DotProtoOption] -> ShowS
DotProtoOption -> String
(Int -> DotProtoOption -> ShowS)
-> (DotProtoOption -> String)
-> ([DotProtoOption] -> ShowS)
-> Show DotProtoOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DotProtoOption] -> ShowS
$cshowList :: [DotProtoOption] -> ShowS
show :: DotProtoOption -> String
$cshow :: DotProtoOption -> String
showsPrec :: Int -> DotProtoOption -> ShowS
$cshowsPrec :: Int -> DotProtoOption -> ShowS
Show)

instance Arbitrary DotProtoOption where
    arbitrary :: Gen DotProtoOption
arbitrary = do
      DotProtoIdentifier
dotProtoOptionIdentifier <- [Gen DotProtoIdentifier] -> Gen DotProtoIdentifier
forall a. [Gen a] -> Gen a
oneof
        [ Gen DotProtoIdentifier
arbitraryPathIdentifier
        , Gen DotProtoIdentifier
arbitraryNestedIdentifier
        ]
      DotProtoValue
dotProtoOptionValue <- Gen DotProtoValue
forall a. Arbitrary a => Gen a
arbitrary
      DotProtoOption -> Gen DotProtoOption
forall (m :: * -> *) a. Monad m => a -> m a
return (DotProtoOption :: DotProtoIdentifier -> DotProtoValue -> DotProtoOption
DotProtoOption {DotProtoValue
DotProtoIdentifier
dotProtoOptionValue :: DotProtoValue
dotProtoOptionIdentifier :: DotProtoIdentifier
dotProtoOptionValue :: DotProtoValue
dotProtoOptionIdentifier :: DotProtoIdentifier
..})

-- | Top-level protocol definitions
data DotProtoDefinition
  = DotProtoMessage String DotProtoIdentifier [DotProtoMessagePart]
  | DotProtoEnum    String DotProtoIdentifier [DotProtoEnumPart]
  | DotProtoService String DotProtoIdentifier [DotProtoServicePart]
  deriving (Typeable DotProtoDefinition
DataType
Constr
Typeable DotProtoDefinition
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> DotProtoDefinition
    -> c DotProtoDefinition)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DotProtoDefinition)
-> (DotProtoDefinition -> Constr)
-> (DotProtoDefinition -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DotProtoDefinition))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DotProtoDefinition))
-> ((forall b. Data b => b -> b)
    -> DotProtoDefinition -> DotProtoDefinition)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DotProtoDefinition -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DotProtoDefinition -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> DotProtoDefinition -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DotProtoDefinition -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DotProtoDefinition -> m DotProtoDefinition)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DotProtoDefinition -> m DotProtoDefinition)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DotProtoDefinition -> m DotProtoDefinition)
-> Data DotProtoDefinition
DotProtoDefinition -> DataType
DotProtoDefinition -> Constr
(forall b. Data b => b -> b)
-> DotProtoDefinition -> DotProtoDefinition
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DotProtoDefinition
-> c DotProtoDefinition
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoDefinition
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) -> DotProtoDefinition -> u
forall u. (forall d. Data d => d -> u) -> DotProtoDefinition -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoDefinition -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoDefinition -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DotProtoDefinition -> m DotProtoDefinition
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DotProtoDefinition -> m DotProtoDefinition
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoDefinition
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DotProtoDefinition
-> c DotProtoDefinition
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DotProtoDefinition)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoDefinition)
$cDotProtoService :: Constr
$cDotProtoEnum :: Constr
$cDotProtoMessage :: Constr
$tDotProtoDefinition :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> DotProtoDefinition -> m DotProtoDefinition
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DotProtoDefinition -> m DotProtoDefinition
gmapMp :: (forall d. Data d => d -> m d)
-> DotProtoDefinition -> m DotProtoDefinition
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DotProtoDefinition -> m DotProtoDefinition
gmapM :: (forall d. Data d => d -> m d)
-> DotProtoDefinition -> m DotProtoDefinition
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DotProtoDefinition -> m DotProtoDefinition
gmapQi :: Int -> (forall d. Data d => d -> u) -> DotProtoDefinition -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DotProtoDefinition -> u
gmapQ :: (forall d. Data d => d -> u) -> DotProtoDefinition -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DotProtoDefinition -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoDefinition -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoDefinition -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoDefinition -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoDefinition -> r
gmapT :: (forall b. Data b => b -> b)
-> DotProtoDefinition -> DotProtoDefinition
$cgmapT :: (forall b. Data b => b -> b)
-> DotProtoDefinition -> DotProtoDefinition
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoDefinition)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoDefinition)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DotProtoDefinition)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DotProtoDefinition)
dataTypeOf :: DotProtoDefinition -> DataType
$cdataTypeOf :: DotProtoDefinition -> DataType
toConstr :: DotProtoDefinition -> Constr
$ctoConstr :: DotProtoDefinition -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoDefinition
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoDefinition
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DotProtoDefinition
-> c DotProtoDefinition
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DotProtoDefinition
-> c DotProtoDefinition
$cp1Data :: Typeable DotProtoDefinition
Data, DotProtoDefinition -> DotProtoDefinition -> Bool
(DotProtoDefinition -> DotProtoDefinition -> Bool)
-> (DotProtoDefinition -> DotProtoDefinition -> Bool)
-> Eq DotProtoDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DotProtoDefinition -> DotProtoDefinition -> Bool
$c/= :: DotProtoDefinition -> DotProtoDefinition -> Bool
== :: DotProtoDefinition -> DotProtoDefinition -> Bool
$c== :: DotProtoDefinition -> DotProtoDefinition -> Bool
Eq, (forall x. DotProtoDefinition -> Rep DotProtoDefinition x)
-> (forall x. Rep DotProtoDefinition x -> DotProtoDefinition)
-> Generic DotProtoDefinition
forall x. Rep DotProtoDefinition x -> DotProtoDefinition
forall x. DotProtoDefinition -> Rep DotProtoDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DotProtoDefinition x -> DotProtoDefinition
$cfrom :: forall x. DotProtoDefinition -> Rep DotProtoDefinition x
Generic, Eq DotProtoDefinition
Eq DotProtoDefinition
-> (DotProtoDefinition -> DotProtoDefinition -> Ordering)
-> (DotProtoDefinition -> DotProtoDefinition -> Bool)
-> (DotProtoDefinition -> DotProtoDefinition -> Bool)
-> (DotProtoDefinition -> DotProtoDefinition -> Bool)
-> (DotProtoDefinition -> DotProtoDefinition -> Bool)
-> (DotProtoDefinition -> DotProtoDefinition -> DotProtoDefinition)
-> (DotProtoDefinition -> DotProtoDefinition -> DotProtoDefinition)
-> Ord DotProtoDefinition
DotProtoDefinition -> DotProtoDefinition -> Bool
DotProtoDefinition -> DotProtoDefinition -> Ordering
DotProtoDefinition -> DotProtoDefinition -> DotProtoDefinition
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DotProtoDefinition -> DotProtoDefinition -> DotProtoDefinition
$cmin :: DotProtoDefinition -> DotProtoDefinition -> DotProtoDefinition
max :: DotProtoDefinition -> DotProtoDefinition -> DotProtoDefinition
$cmax :: DotProtoDefinition -> DotProtoDefinition -> DotProtoDefinition
>= :: DotProtoDefinition -> DotProtoDefinition -> Bool
$c>= :: DotProtoDefinition -> DotProtoDefinition -> Bool
> :: DotProtoDefinition -> DotProtoDefinition -> Bool
$c> :: DotProtoDefinition -> DotProtoDefinition -> Bool
<= :: DotProtoDefinition -> DotProtoDefinition -> Bool
$c<= :: DotProtoDefinition -> DotProtoDefinition -> Bool
< :: DotProtoDefinition -> DotProtoDefinition -> Bool
$c< :: DotProtoDefinition -> DotProtoDefinition -> Bool
compare :: DotProtoDefinition -> DotProtoDefinition -> Ordering
$ccompare :: DotProtoDefinition -> DotProtoDefinition -> Ordering
$cp1Ord :: Eq DotProtoDefinition
Ord, Int -> DotProtoDefinition -> ShowS
[DotProtoDefinition] -> ShowS
DotProtoDefinition -> String
(Int -> DotProtoDefinition -> ShowS)
-> (DotProtoDefinition -> String)
-> ([DotProtoDefinition] -> ShowS)
-> Show DotProtoDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DotProtoDefinition] -> ShowS
$cshowList :: [DotProtoDefinition] -> ShowS
show :: DotProtoDefinition -> String
$cshow :: DotProtoDefinition -> String
showsPrec :: Int -> DotProtoDefinition -> ShowS
$cshowsPrec :: Int -> DotProtoDefinition -> ShowS
Show)

instance Arbitrary DotProtoDefinition where
  arbitrary :: Gen DotProtoDefinition
arbitrary = [Gen DotProtoDefinition] -> Gen DotProtoDefinition
forall a. [Gen a] -> Gen a
oneof [Gen DotProtoDefinition
arbitraryMessage, Gen DotProtoDefinition
arbitraryEnum]
    where
      arbitraryMessage :: Gen DotProtoDefinition
arbitraryMessage = do
        String
comment    <- String -> Gen String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
forall a. Monoid a => a
mempty  -- until parser supports comments
        DotProtoIdentifier
identifier <- Gen DotProtoIdentifier
arbitrarySingleIdentifier
        [DotProtoMessagePart]
parts      <- Gen DotProtoMessagePart -> Gen [DotProtoMessagePart]
forall a. Gen a -> Gen [a]
smallListOf Gen DotProtoMessagePart
forall a. Arbitrary a => Gen a
arbitrary
        DotProtoDefinition -> Gen DotProtoDefinition
forall (m :: * -> *) a. Monad m => a -> m a
return (String
-> DotProtoIdentifier
-> [DotProtoMessagePart]
-> DotProtoDefinition
DotProtoMessage String
comment DotProtoIdentifier
identifier [DotProtoMessagePart]
parts)

      arbitraryEnum :: Gen DotProtoDefinition
arbitraryEnum = do
        String
comment    <- String -> Gen String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
forall a. Monoid a => a
mempty  -- until parser supports comments
        DotProtoIdentifier
identifier <- Gen DotProtoIdentifier
arbitrarySingleIdentifier
        [DotProtoEnumPart]
parts      <- Gen DotProtoEnumPart -> Gen [DotProtoEnumPart]
forall a. Gen a -> Gen [a]
smallListOf Gen DotProtoEnumPart
forall a. Arbitrary a => Gen a
arbitrary
        DotProtoDefinition -> Gen DotProtoDefinition
forall (m :: * -> *) a. Monad m => a -> m a
return (String
-> DotProtoIdentifier -> [DotProtoEnumPart] -> DotProtoDefinition
DotProtoEnum String
comment DotProtoIdentifier
identifier [DotProtoEnumPart]
parts)

-- | Tracks misc metadata about the AST
data DotProtoMeta = DotProtoMeta
  { DotProtoMeta -> Path
metaModulePath :: Path
    -- ^ The "module path" associated with the .proto file from which this AST
    -- was parsed. The "module path" is derived from the `--includeDir`-relative
    -- .proto filename passed to 'parseProtoFile'. See
    -- 'Proto3.Suite.DotProto.Internal.toModulePath' for details on how module
    -- path values are constructed. See
    -- 'Proto3.Suite.DotProto.Generate.modulePathModName' to see how it is used
    -- during code generation.
  } deriving (Typeable DotProtoMeta
DataType
Constr
Typeable DotProtoMeta
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DotProtoMeta -> c DotProtoMeta)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DotProtoMeta)
-> (DotProtoMeta -> Constr)
-> (DotProtoMeta -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DotProtoMeta))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DotProtoMeta))
-> ((forall b. Data b => b -> b) -> DotProtoMeta -> DotProtoMeta)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DotProtoMeta -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DotProtoMeta -> r)
-> (forall u. (forall d. Data d => d -> u) -> DotProtoMeta -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DotProtoMeta -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DotProtoMeta -> m DotProtoMeta)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DotProtoMeta -> m DotProtoMeta)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DotProtoMeta -> m DotProtoMeta)
-> Data DotProtoMeta
DotProtoMeta -> DataType
DotProtoMeta -> Constr
(forall b. Data b => b -> b) -> DotProtoMeta -> DotProtoMeta
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProtoMeta -> c DotProtoMeta
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoMeta
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) -> DotProtoMeta -> u
forall u. (forall d. Data d => d -> u) -> DotProtoMeta -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoMeta -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoMeta -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DotProtoMeta -> m DotProtoMeta
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DotProtoMeta -> m DotProtoMeta
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoMeta
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProtoMeta -> c DotProtoMeta
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DotProtoMeta)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoMeta)
$cDotProtoMeta :: Constr
$tDotProtoMeta :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> DotProtoMeta -> m DotProtoMeta
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DotProtoMeta -> m DotProtoMeta
gmapMp :: (forall d. Data d => d -> m d) -> DotProtoMeta -> m DotProtoMeta
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DotProtoMeta -> m DotProtoMeta
gmapM :: (forall d. Data d => d -> m d) -> DotProtoMeta -> m DotProtoMeta
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DotProtoMeta -> m DotProtoMeta
gmapQi :: Int -> (forall d. Data d => d -> u) -> DotProtoMeta -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DotProtoMeta -> u
gmapQ :: (forall d. Data d => d -> u) -> DotProtoMeta -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DotProtoMeta -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoMeta -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoMeta -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoMeta -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoMeta -> r
gmapT :: (forall b. Data b => b -> b) -> DotProtoMeta -> DotProtoMeta
$cgmapT :: (forall b. Data b => b -> b) -> DotProtoMeta -> DotProtoMeta
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoMeta)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoMeta)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DotProtoMeta)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DotProtoMeta)
dataTypeOf :: DotProtoMeta -> DataType
$cdataTypeOf :: DotProtoMeta -> DataType
toConstr :: DotProtoMeta -> Constr
$ctoConstr :: DotProtoMeta -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoMeta
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoMeta
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProtoMeta -> c DotProtoMeta
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProtoMeta -> c DotProtoMeta
$cp1Data :: Typeable DotProtoMeta
Data, DotProtoMeta -> DotProtoMeta -> Bool
(DotProtoMeta -> DotProtoMeta -> Bool)
-> (DotProtoMeta -> DotProtoMeta -> Bool) -> Eq DotProtoMeta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DotProtoMeta -> DotProtoMeta -> Bool
$c/= :: DotProtoMeta -> DotProtoMeta -> Bool
== :: DotProtoMeta -> DotProtoMeta -> Bool
$c== :: DotProtoMeta -> DotProtoMeta -> Bool
Eq, (forall x. DotProtoMeta -> Rep DotProtoMeta x)
-> (forall x. Rep DotProtoMeta x -> DotProtoMeta)
-> Generic DotProtoMeta
forall x. Rep DotProtoMeta x -> DotProtoMeta
forall x. DotProtoMeta -> Rep DotProtoMeta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DotProtoMeta x -> DotProtoMeta
$cfrom :: forall x. DotProtoMeta -> Rep DotProtoMeta x
Generic, Eq DotProtoMeta
Eq DotProtoMeta
-> (DotProtoMeta -> DotProtoMeta -> Ordering)
-> (DotProtoMeta -> DotProtoMeta -> Bool)
-> (DotProtoMeta -> DotProtoMeta -> Bool)
-> (DotProtoMeta -> DotProtoMeta -> Bool)
-> (DotProtoMeta -> DotProtoMeta -> Bool)
-> (DotProtoMeta -> DotProtoMeta -> DotProtoMeta)
-> (DotProtoMeta -> DotProtoMeta -> DotProtoMeta)
-> Ord DotProtoMeta
DotProtoMeta -> DotProtoMeta -> Bool
DotProtoMeta -> DotProtoMeta -> Ordering
DotProtoMeta -> DotProtoMeta -> DotProtoMeta
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DotProtoMeta -> DotProtoMeta -> DotProtoMeta
$cmin :: DotProtoMeta -> DotProtoMeta -> DotProtoMeta
max :: DotProtoMeta -> DotProtoMeta -> DotProtoMeta
$cmax :: DotProtoMeta -> DotProtoMeta -> DotProtoMeta
>= :: DotProtoMeta -> DotProtoMeta -> Bool
$c>= :: DotProtoMeta -> DotProtoMeta -> Bool
> :: DotProtoMeta -> DotProtoMeta -> Bool
$c> :: DotProtoMeta -> DotProtoMeta -> Bool
<= :: DotProtoMeta -> DotProtoMeta -> Bool
$c<= :: DotProtoMeta -> DotProtoMeta -> Bool
< :: DotProtoMeta -> DotProtoMeta -> Bool
$c< :: DotProtoMeta -> DotProtoMeta -> Bool
compare :: DotProtoMeta -> DotProtoMeta -> Ordering
$ccompare :: DotProtoMeta -> DotProtoMeta -> Ordering
$cp1Ord :: Eq DotProtoMeta
Ord, Int -> DotProtoMeta -> ShowS
[DotProtoMeta] -> ShowS
DotProtoMeta -> String
(Int -> DotProtoMeta -> ShowS)
-> (DotProtoMeta -> String)
-> ([DotProtoMeta] -> ShowS)
-> Show DotProtoMeta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DotProtoMeta] -> ShowS
$cshowList :: [DotProtoMeta] -> ShowS
show :: DotProtoMeta -> String
$cshow :: DotProtoMeta -> String
showsPrec :: Int -> DotProtoMeta -> ShowS
$cshowsPrec :: Int -> DotProtoMeta -> ShowS
Show)

instance Arbitrary DotProtoMeta where
  arbitrary :: Gen DotProtoMeta
arbitrary = DotProtoMeta -> Gen DotProtoMeta
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path -> DotProtoMeta
DotProtoMeta Path
fakePath)

-- | This data structure represents a .proto file
--   The actual source order of protobuf statements isn't meaningful so
--   statements are sorted by type during parsing.
--   A .proto file with more than one package declaration is considered invalid.
data DotProto = DotProto
  { DotProto -> [DotProtoImport]
protoImports     :: [DotProtoImport]
  , DotProto -> [DotProtoOption]
protoOptions     :: [DotProtoOption]
  , DotProto -> DotProtoPackageSpec
protoPackage     :: DotProtoPackageSpec
  , DotProto -> [DotProtoDefinition]
protoDefinitions :: [DotProtoDefinition]
  , DotProto -> DotProtoMeta
protoMeta        :: DotProtoMeta
  } deriving (Typeable DotProto
DataType
Constr
Typeable DotProto
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DotProto -> c DotProto)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DotProto)
-> (DotProto -> Constr)
-> (DotProto -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DotProto))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DotProto))
-> ((forall b. Data b => b -> b) -> DotProto -> DotProto)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DotProto -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DotProto -> r)
-> (forall u. (forall d. Data d => d -> u) -> DotProto -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> DotProto -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DotProto -> m DotProto)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DotProto -> m DotProto)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DotProto -> m DotProto)
-> Data DotProto
DotProto -> DataType
DotProto -> Constr
(forall b. Data b => b -> b) -> DotProto -> DotProto
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProto -> c DotProto
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProto
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) -> DotProto -> u
forall u. (forall d. Data d => d -> u) -> DotProto -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProto -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProto -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DotProto -> m DotProto
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DotProto -> m DotProto
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProto
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProto -> c DotProto
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DotProto)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DotProto)
$cDotProto :: Constr
$tDotProto :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> DotProto -> m DotProto
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DotProto -> m DotProto
gmapMp :: (forall d. Data d => d -> m d) -> DotProto -> m DotProto
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DotProto -> m DotProto
gmapM :: (forall d. Data d => d -> m d) -> DotProto -> m DotProto
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DotProto -> m DotProto
gmapQi :: Int -> (forall d. Data d => d -> u) -> DotProto -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DotProto -> u
gmapQ :: (forall d. Data d => d -> u) -> DotProto -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DotProto -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProto -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProto -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProto -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProto -> r
gmapT :: (forall b. Data b => b -> b) -> DotProto -> DotProto
$cgmapT :: (forall b. Data b => b -> b) -> DotProto -> DotProto
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DotProto)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DotProto)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DotProto)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DotProto)
dataTypeOf :: DotProto -> DataType
$cdataTypeOf :: DotProto -> DataType
toConstr :: DotProto -> Constr
$ctoConstr :: DotProto -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProto
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProto
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProto -> c DotProto
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProto -> c DotProto
$cp1Data :: Typeable DotProto
Data, DotProto -> DotProto -> Bool
(DotProto -> DotProto -> Bool)
-> (DotProto -> DotProto -> Bool) -> Eq DotProto
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DotProto -> DotProto -> Bool
$c/= :: DotProto -> DotProto -> Bool
== :: DotProto -> DotProto -> Bool
$c== :: DotProto -> DotProto -> Bool
Eq, (forall x. DotProto -> Rep DotProto x)
-> (forall x. Rep DotProto x -> DotProto) -> Generic DotProto
forall x. Rep DotProto x -> DotProto
forall x. DotProto -> Rep DotProto x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DotProto x -> DotProto
$cfrom :: forall x. DotProto -> Rep DotProto x
Generic, Eq DotProto
Eq DotProto
-> (DotProto -> DotProto -> Ordering)
-> (DotProto -> DotProto -> Bool)
-> (DotProto -> DotProto -> Bool)
-> (DotProto -> DotProto -> Bool)
-> (DotProto -> DotProto -> Bool)
-> (DotProto -> DotProto -> DotProto)
-> (DotProto -> DotProto -> DotProto)
-> Ord DotProto
DotProto -> DotProto -> Bool
DotProto -> DotProto -> Ordering
DotProto -> DotProto -> DotProto
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DotProto -> DotProto -> DotProto
$cmin :: DotProto -> DotProto -> DotProto
max :: DotProto -> DotProto -> DotProto
$cmax :: DotProto -> DotProto -> DotProto
>= :: DotProto -> DotProto -> Bool
$c>= :: DotProto -> DotProto -> Bool
> :: DotProto -> DotProto -> Bool
$c> :: DotProto -> DotProto -> Bool
<= :: DotProto -> DotProto -> Bool
$c<= :: DotProto -> DotProto -> Bool
< :: DotProto -> DotProto -> Bool
$c< :: DotProto -> DotProto -> Bool
compare :: DotProto -> DotProto -> Ordering
$ccompare :: DotProto -> DotProto -> Ordering
$cp1Ord :: Eq DotProto
Ord, Int -> DotProto -> ShowS
[DotProto] -> ShowS
DotProto -> String
(Int -> DotProto -> ShowS)
-> (DotProto -> String) -> ([DotProto] -> ShowS) -> Show DotProto
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DotProto] -> ShowS
$cshowList :: [DotProto] -> ShowS
show :: DotProto -> String
$cshow :: DotProto -> String
showsPrec :: Int -> DotProto -> ShowS
$cshowsPrec :: Int -> DotProto -> ShowS
Show)

instance Arbitrary DotProto where
  arbitrary :: Gen DotProto
arbitrary = do
    [DotProtoImport]
protoImports     <- Gen DotProtoImport -> Gen [DotProtoImport]
forall a. Gen a -> Gen [a]
smallListOf Gen DotProtoImport
forall a. Arbitrary a => Gen a
arbitrary
    [DotProtoOption]
protoOptions     <- Gen DotProtoOption -> Gen [DotProtoOption]
forall a. Gen a -> Gen [a]
smallListOf Gen DotProtoOption
forall a. Arbitrary a => Gen a
arbitrary
    DotProtoPackageSpec
protoPackage     <- Gen DotProtoPackageSpec
forall a. Arbitrary a => Gen a
arbitrary
    [DotProtoDefinition]
protoDefinitions <- Gen DotProtoDefinition -> Gen [DotProtoDefinition]
forall a. Gen a -> Gen [a]
smallListOf Gen DotProtoDefinition
forall a. Arbitrary a => Gen a
arbitrary
    DotProtoMeta
protoMeta        <- Gen DotProtoMeta
forall a. Arbitrary a => Gen a
arbitrary
    DotProto -> Gen DotProto
forall (m :: * -> *) a. Monad m => a -> m a
return (DotProto :: [DotProtoImport]
-> [DotProtoOption]
-> DotProtoPackageSpec
-> [DotProtoDefinition]
-> DotProtoMeta
-> DotProto
DotProto {[DotProtoDefinition]
[DotProtoOption]
[DotProtoImport]
DotProtoMeta
DotProtoPackageSpec
protoMeta :: DotProtoMeta
protoDefinitions :: [DotProtoDefinition]
protoPackage :: DotProtoPackageSpec
protoOptions :: [DotProtoOption]
protoImports :: [DotProtoImport]
protoMeta :: DotProtoMeta
protoDefinitions :: [DotProtoDefinition]
protoPackage :: DotProtoPackageSpec
protoOptions :: [DotProtoOption]
protoImports :: [DotProtoImport]
..})

-- | Matches the definition of `constant` in the proto3 language spec
--   These are only used as rvalues
data DotProtoValue
  = Identifier DotProtoIdentifier
  | StringLit  String
  | IntLit     Int
  | FloatLit   Double
  | BoolLit    Bool
  deriving (Typeable DotProtoValue
DataType
Constr
Typeable DotProtoValue
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DotProtoValue -> c DotProtoValue)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DotProtoValue)
-> (DotProtoValue -> Constr)
-> (DotProtoValue -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DotProtoValue))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DotProtoValue))
-> ((forall b. Data b => b -> b) -> DotProtoValue -> DotProtoValue)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DotProtoValue -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DotProtoValue -> r)
-> (forall u. (forall d. Data d => d -> u) -> DotProtoValue -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DotProtoValue -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DotProtoValue -> m DotProtoValue)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DotProtoValue -> m DotProtoValue)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DotProtoValue -> m DotProtoValue)
-> Data DotProtoValue
DotProtoValue -> DataType
DotProtoValue -> Constr
(forall b. Data b => b -> b) -> DotProtoValue -> DotProtoValue
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProtoValue -> c DotProtoValue
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoValue
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) -> DotProtoValue -> u
forall u. (forall d. Data d => d -> u) -> DotProtoValue -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoValue -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoValue -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DotProtoValue -> m DotProtoValue
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DotProtoValue -> m DotProtoValue
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoValue
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProtoValue -> c DotProtoValue
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DotProtoValue)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoValue)
$cBoolLit :: Constr
$cFloatLit :: Constr
$cIntLit :: Constr
$cStringLit :: Constr
$cIdentifier :: Constr
$tDotProtoValue :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> DotProtoValue -> m DotProtoValue
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DotProtoValue -> m DotProtoValue
gmapMp :: (forall d. Data d => d -> m d) -> DotProtoValue -> m DotProtoValue
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DotProtoValue -> m DotProtoValue
gmapM :: (forall d. Data d => d -> m d) -> DotProtoValue -> m DotProtoValue
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DotProtoValue -> m DotProtoValue
gmapQi :: Int -> (forall d. Data d => d -> u) -> DotProtoValue -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DotProtoValue -> u
gmapQ :: (forall d. Data d => d -> u) -> DotProtoValue -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DotProtoValue -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoValue -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoValue -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoValue -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoValue -> r
gmapT :: (forall b. Data b => b -> b) -> DotProtoValue -> DotProtoValue
$cgmapT :: (forall b. Data b => b -> b) -> DotProtoValue -> DotProtoValue
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoValue)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoValue)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DotProtoValue)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DotProtoValue)
dataTypeOf :: DotProtoValue -> DataType
$cdataTypeOf :: DotProtoValue -> DataType
toConstr :: DotProtoValue -> Constr
$ctoConstr :: DotProtoValue -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoValue
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoValue
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProtoValue -> c DotProtoValue
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProtoValue -> c DotProtoValue
$cp1Data :: Typeable DotProtoValue
Data, DotProtoValue -> DotProtoValue -> Bool
(DotProtoValue -> DotProtoValue -> Bool)
-> (DotProtoValue -> DotProtoValue -> Bool) -> Eq DotProtoValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DotProtoValue -> DotProtoValue -> Bool
$c/= :: DotProtoValue -> DotProtoValue -> Bool
== :: DotProtoValue -> DotProtoValue -> Bool
$c== :: DotProtoValue -> DotProtoValue -> Bool
Eq, (forall x. DotProtoValue -> Rep DotProtoValue x)
-> (forall x. Rep DotProtoValue x -> DotProtoValue)
-> Generic DotProtoValue
forall x. Rep DotProtoValue x -> DotProtoValue
forall x. DotProtoValue -> Rep DotProtoValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DotProtoValue x -> DotProtoValue
$cfrom :: forall x. DotProtoValue -> Rep DotProtoValue x
Generic, Eq DotProtoValue
Eq DotProtoValue
-> (DotProtoValue -> DotProtoValue -> Ordering)
-> (DotProtoValue -> DotProtoValue -> Bool)
-> (DotProtoValue -> DotProtoValue -> Bool)
-> (DotProtoValue -> DotProtoValue -> Bool)
-> (DotProtoValue -> DotProtoValue -> Bool)
-> (DotProtoValue -> DotProtoValue -> DotProtoValue)
-> (DotProtoValue -> DotProtoValue -> DotProtoValue)
-> Ord DotProtoValue
DotProtoValue -> DotProtoValue -> Bool
DotProtoValue -> DotProtoValue -> Ordering
DotProtoValue -> DotProtoValue -> DotProtoValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DotProtoValue -> DotProtoValue -> DotProtoValue
$cmin :: DotProtoValue -> DotProtoValue -> DotProtoValue
max :: DotProtoValue -> DotProtoValue -> DotProtoValue
$cmax :: DotProtoValue -> DotProtoValue -> DotProtoValue
>= :: DotProtoValue -> DotProtoValue -> Bool
$c>= :: DotProtoValue -> DotProtoValue -> Bool
> :: DotProtoValue -> DotProtoValue -> Bool
$c> :: DotProtoValue -> DotProtoValue -> Bool
<= :: DotProtoValue -> DotProtoValue -> Bool
$c<= :: DotProtoValue -> DotProtoValue -> Bool
< :: DotProtoValue -> DotProtoValue -> Bool
$c< :: DotProtoValue -> DotProtoValue -> Bool
compare :: DotProtoValue -> DotProtoValue -> Ordering
$ccompare :: DotProtoValue -> DotProtoValue -> Ordering
$cp1Ord :: Eq DotProtoValue
Ord, Int -> DotProtoValue -> ShowS
[DotProtoValue] -> ShowS
DotProtoValue -> String
(Int -> DotProtoValue -> ShowS)
-> (DotProtoValue -> String)
-> ([DotProtoValue] -> ShowS)
-> Show DotProtoValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DotProtoValue] -> ShowS
$cshowList :: [DotProtoValue] -> ShowS
show :: DotProtoValue -> String
$cshow :: DotProtoValue -> String
showsPrec :: Int -> DotProtoValue -> ShowS
$cshowsPrec :: Int -> DotProtoValue -> ShowS
Show)

instance Arbitrary DotProtoValue where
  arbitrary :: Gen DotProtoValue
arbitrary = [Gen DotProtoValue] -> Gen DotProtoValue
forall a. [Gen a] -> Gen a
oneof
    [ (DotProtoIdentifier -> DotProtoValue)
-> Gen DotProtoIdentifier -> Gen DotProtoValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DotProtoIdentifier -> DotProtoValue
Identifier  Gen DotProtoIdentifier
arbitrarySingleIdentifier
    , (String -> DotProtoValue) -> Gen String -> Gen DotProtoValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> DotProtoValue
StringLit  (String -> Gen String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"")
    , (Int -> DotProtoValue) -> Gen Int -> Gen DotProtoValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> DotProtoValue
IntLit      Gen Int
forall a. Arbitrary a => Gen a
arbitrary
    , (Double -> DotProtoValue) -> Gen Double -> Gen DotProtoValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> DotProtoValue
FloatLit    Gen Double
forall a. Arbitrary a => Gen a
arbitrary
    , (Bool -> DotProtoValue) -> Gen Bool -> Gen DotProtoValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> DotProtoValue
BoolLit     Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
    ]

data DotProtoPrimType
  = Int32
  | Int64
  | SInt32
  | SInt64
  | UInt32
  | UInt64
  | Fixed32
  | Fixed64
  | SFixed32
  | SFixed64
  | String
  | Bytes
  | Bool
  | Float
  | Double
  | Named DotProtoIdentifier
  -- ^ A named type, referring to another message or enum defined in the same file
  deriving (Typeable DotProtoPrimType
DataType
Constr
Typeable DotProtoPrimType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DotProtoPrimType -> c DotProtoPrimType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DotProtoPrimType)
-> (DotProtoPrimType -> Constr)
-> (DotProtoPrimType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DotProtoPrimType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DotProtoPrimType))
-> ((forall b. Data b => b -> b)
    -> DotProtoPrimType -> DotProtoPrimType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DotProtoPrimType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DotProtoPrimType -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> DotProtoPrimType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DotProtoPrimType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DotProtoPrimType -> m DotProtoPrimType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DotProtoPrimType -> m DotProtoPrimType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DotProtoPrimType -> m DotProtoPrimType)
-> Data DotProtoPrimType
DotProtoPrimType -> DataType
DotProtoPrimType -> Constr
(forall b. Data b => b -> b)
-> DotProtoPrimType -> DotProtoPrimType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProtoPrimType -> c DotProtoPrimType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoPrimType
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) -> DotProtoPrimType -> u
forall u. (forall d. Data d => d -> u) -> DotProtoPrimType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoPrimType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoPrimType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DotProtoPrimType -> m DotProtoPrimType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DotProtoPrimType -> m DotProtoPrimType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoPrimType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProtoPrimType -> c DotProtoPrimType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DotProtoPrimType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoPrimType)
$cNamed :: Constr
$cDouble :: Constr
$cFloat :: Constr
$cBool :: Constr
$cBytes :: Constr
$cString :: Constr
$cSFixed64 :: Constr
$cSFixed32 :: Constr
$cFixed64 :: Constr
$cFixed32 :: Constr
$cUInt64 :: Constr
$cUInt32 :: Constr
$cSInt64 :: Constr
$cSInt32 :: Constr
$cInt64 :: Constr
$cInt32 :: Constr
$tDotProtoPrimType :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> DotProtoPrimType -> m DotProtoPrimType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DotProtoPrimType -> m DotProtoPrimType
gmapMp :: (forall d. Data d => d -> m d)
-> DotProtoPrimType -> m DotProtoPrimType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DotProtoPrimType -> m DotProtoPrimType
gmapM :: (forall d. Data d => d -> m d)
-> DotProtoPrimType -> m DotProtoPrimType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DotProtoPrimType -> m DotProtoPrimType
gmapQi :: Int -> (forall d. Data d => d -> u) -> DotProtoPrimType -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DotProtoPrimType -> u
gmapQ :: (forall d. Data d => d -> u) -> DotProtoPrimType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DotProtoPrimType -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoPrimType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoPrimType -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoPrimType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoPrimType -> r
gmapT :: (forall b. Data b => b -> b)
-> DotProtoPrimType -> DotProtoPrimType
$cgmapT :: (forall b. Data b => b -> b)
-> DotProtoPrimType -> DotProtoPrimType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoPrimType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoPrimType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DotProtoPrimType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DotProtoPrimType)
dataTypeOf :: DotProtoPrimType -> DataType
$cdataTypeOf :: DotProtoPrimType -> DataType
toConstr :: DotProtoPrimType -> Constr
$ctoConstr :: DotProtoPrimType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoPrimType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoPrimType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProtoPrimType -> c DotProtoPrimType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProtoPrimType -> c DotProtoPrimType
$cp1Data :: Typeable DotProtoPrimType
Data, DotProtoPrimType -> DotProtoPrimType -> Bool
(DotProtoPrimType -> DotProtoPrimType -> Bool)
-> (DotProtoPrimType -> DotProtoPrimType -> Bool)
-> Eq DotProtoPrimType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DotProtoPrimType -> DotProtoPrimType -> Bool
$c/= :: DotProtoPrimType -> DotProtoPrimType -> Bool
== :: DotProtoPrimType -> DotProtoPrimType -> Bool
$c== :: DotProtoPrimType -> DotProtoPrimType -> Bool
Eq, (forall x. DotProtoPrimType -> Rep DotProtoPrimType x)
-> (forall x. Rep DotProtoPrimType x -> DotProtoPrimType)
-> Generic DotProtoPrimType
forall x. Rep DotProtoPrimType x -> DotProtoPrimType
forall x. DotProtoPrimType -> Rep DotProtoPrimType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DotProtoPrimType x -> DotProtoPrimType
$cfrom :: forall x. DotProtoPrimType -> Rep DotProtoPrimType x
Generic, Eq DotProtoPrimType
Eq DotProtoPrimType
-> (DotProtoPrimType -> DotProtoPrimType -> Ordering)
-> (DotProtoPrimType -> DotProtoPrimType -> Bool)
-> (DotProtoPrimType -> DotProtoPrimType -> Bool)
-> (DotProtoPrimType -> DotProtoPrimType -> Bool)
-> (DotProtoPrimType -> DotProtoPrimType -> Bool)
-> (DotProtoPrimType -> DotProtoPrimType -> DotProtoPrimType)
-> (DotProtoPrimType -> DotProtoPrimType -> DotProtoPrimType)
-> Ord DotProtoPrimType
DotProtoPrimType -> DotProtoPrimType -> Bool
DotProtoPrimType -> DotProtoPrimType -> Ordering
DotProtoPrimType -> DotProtoPrimType -> DotProtoPrimType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DotProtoPrimType -> DotProtoPrimType -> DotProtoPrimType
$cmin :: DotProtoPrimType -> DotProtoPrimType -> DotProtoPrimType
max :: DotProtoPrimType -> DotProtoPrimType -> DotProtoPrimType
$cmax :: DotProtoPrimType -> DotProtoPrimType -> DotProtoPrimType
>= :: DotProtoPrimType -> DotProtoPrimType -> Bool
$c>= :: DotProtoPrimType -> DotProtoPrimType -> Bool
> :: DotProtoPrimType -> DotProtoPrimType -> Bool
$c> :: DotProtoPrimType -> DotProtoPrimType -> Bool
<= :: DotProtoPrimType -> DotProtoPrimType -> Bool
$c<= :: DotProtoPrimType -> DotProtoPrimType -> Bool
< :: DotProtoPrimType -> DotProtoPrimType -> Bool
$c< :: DotProtoPrimType -> DotProtoPrimType -> Bool
compare :: DotProtoPrimType -> DotProtoPrimType -> Ordering
$ccompare :: DotProtoPrimType -> DotProtoPrimType -> Ordering
$cp1Ord :: Eq DotProtoPrimType
Ord, Int -> DotProtoPrimType -> ShowS
[DotProtoPrimType] -> ShowS
DotProtoPrimType -> String
(Int -> DotProtoPrimType -> ShowS)
-> (DotProtoPrimType -> String)
-> ([DotProtoPrimType] -> ShowS)
-> Show DotProtoPrimType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DotProtoPrimType] -> ShowS
$cshowList :: [DotProtoPrimType] -> ShowS
show :: DotProtoPrimType -> String
$cshow :: DotProtoPrimType -> String
showsPrec :: Int -> DotProtoPrimType -> ShowS
$cshowsPrec :: Int -> DotProtoPrimType -> ShowS
Show)

instance Arbitrary DotProtoPrimType where
  arbitrary :: Gen DotProtoPrimType
arbitrary = [Gen DotProtoPrimType] -> Gen DotProtoPrimType
forall a. [Gen a] -> Gen a
oneof
    [ [DotProtoPrimType] -> Gen DotProtoPrimType
forall a. [a] -> Gen a
elements
      [ DotProtoPrimType
Int32
      , DotProtoPrimType
Int64
      , DotProtoPrimType
SInt32
      , DotProtoPrimType
SInt64
      , DotProtoPrimType
UInt32
      , DotProtoPrimType
UInt64
      , DotProtoPrimType
Fixed32
      , DotProtoPrimType
Fixed64
      , DotProtoPrimType
SFixed32
      , DotProtoPrimType
SFixed64
      , DotProtoPrimType
String
      , DotProtoPrimType
Bytes
      , DotProtoPrimType
Bool
      , DotProtoPrimType
Float
      , DotProtoPrimType
Double
      ]
    , (DotProtoIdentifier -> DotProtoPrimType)
-> Gen DotProtoIdentifier -> Gen DotProtoPrimType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DotProtoIdentifier -> DotProtoPrimType
Named Gen DotProtoIdentifier
arbitrarySingleIdentifier
    ]

data Packing
  = PackedField
  | UnpackedField
  deriving (Packing
Packing -> Packing -> Bounded Packing
forall a. a -> a -> Bounded a
maxBound :: Packing
$cmaxBound :: Packing
minBound :: Packing
$cminBound :: Packing
Bounded, Typeable Packing
DataType
Constr
Typeable Packing
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Packing -> c Packing)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Packing)
-> (Packing -> Constr)
-> (Packing -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Packing))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Packing))
-> ((forall b. Data b => b -> b) -> Packing -> Packing)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Packing -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Packing -> r)
-> (forall u. (forall d. Data d => d -> u) -> Packing -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Packing -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Packing -> m Packing)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Packing -> m Packing)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Packing -> m Packing)
-> Data Packing
Packing -> DataType
Packing -> Constr
(forall b. Data b => b -> b) -> Packing -> Packing
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Packing -> c Packing
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Packing
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) -> Packing -> u
forall u. (forall d. Data d => d -> u) -> Packing -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Packing -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Packing -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Packing -> m Packing
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Packing -> m Packing
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Packing
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Packing -> c Packing
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Packing)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Packing)
$cUnpackedField :: Constr
$cPackedField :: Constr
$tPacking :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Packing -> m Packing
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Packing -> m Packing
gmapMp :: (forall d. Data d => d -> m d) -> Packing -> m Packing
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Packing -> m Packing
gmapM :: (forall d. Data d => d -> m d) -> Packing -> m Packing
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Packing -> m Packing
gmapQi :: Int -> (forall d. Data d => d -> u) -> Packing -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Packing -> u
gmapQ :: (forall d. Data d => d -> u) -> Packing -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Packing -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Packing -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Packing -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Packing -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Packing -> r
gmapT :: (forall b. Data b => b -> b) -> Packing -> Packing
$cgmapT :: (forall b. Data b => b -> b) -> Packing -> Packing
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Packing)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Packing)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Packing)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Packing)
dataTypeOf :: Packing -> DataType
$cdataTypeOf :: Packing -> DataType
toConstr :: Packing -> Constr
$ctoConstr :: Packing -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Packing
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Packing
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Packing -> c Packing
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Packing -> c Packing
$cp1Data :: Typeable Packing
Data, Int -> Packing
Packing -> Int
Packing -> [Packing]
Packing -> Packing
Packing -> Packing -> [Packing]
Packing -> Packing -> Packing -> [Packing]
(Packing -> Packing)
-> (Packing -> Packing)
-> (Int -> Packing)
-> (Packing -> Int)
-> (Packing -> [Packing])
-> (Packing -> Packing -> [Packing])
-> (Packing -> Packing -> [Packing])
-> (Packing -> Packing -> Packing -> [Packing])
-> Enum Packing
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Packing -> Packing -> Packing -> [Packing]
$cenumFromThenTo :: Packing -> Packing -> Packing -> [Packing]
enumFromTo :: Packing -> Packing -> [Packing]
$cenumFromTo :: Packing -> Packing -> [Packing]
enumFromThen :: Packing -> Packing -> [Packing]
$cenumFromThen :: Packing -> Packing -> [Packing]
enumFrom :: Packing -> [Packing]
$cenumFrom :: Packing -> [Packing]
fromEnum :: Packing -> Int
$cfromEnum :: Packing -> Int
toEnum :: Int -> Packing
$ctoEnum :: Int -> Packing
pred :: Packing -> Packing
$cpred :: Packing -> Packing
succ :: Packing -> Packing
$csucc :: Packing -> Packing
Enum, Packing -> Packing -> Bool
(Packing -> Packing -> Bool)
-> (Packing -> Packing -> Bool) -> Eq Packing
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Packing -> Packing -> Bool
$c/= :: Packing -> Packing -> Bool
== :: Packing -> Packing -> Bool
$c== :: Packing -> Packing -> Bool
Eq, (forall x. Packing -> Rep Packing x)
-> (forall x. Rep Packing x -> Packing) -> Generic Packing
forall x. Rep Packing x -> Packing
forall x. Packing -> Rep Packing x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Packing x -> Packing
$cfrom :: forall x. Packing -> Rep Packing x
Generic, Eq Packing
Eq Packing
-> (Packing -> Packing -> Ordering)
-> (Packing -> Packing -> Bool)
-> (Packing -> Packing -> Bool)
-> (Packing -> Packing -> Bool)
-> (Packing -> Packing -> Bool)
-> (Packing -> Packing -> Packing)
-> (Packing -> Packing -> Packing)
-> Ord Packing
Packing -> Packing -> Bool
Packing -> Packing -> Ordering
Packing -> Packing -> Packing
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Packing -> Packing -> Packing
$cmin :: Packing -> Packing -> Packing
max :: Packing -> Packing -> Packing
$cmax :: Packing -> Packing -> Packing
>= :: Packing -> Packing -> Bool
$c>= :: Packing -> Packing -> Bool
> :: Packing -> Packing -> Bool
$c> :: Packing -> Packing -> Bool
<= :: Packing -> Packing -> Bool
$c<= :: Packing -> Packing -> Bool
< :: Packing -> Packing -> Bool
$c< :: Packing -> Packing -> Bool
compare :: Packing -> Packing -> Ordering
$ccompare :: Packing -> Packing -> Ordering
$cp1Ord :: Eq Packing
Ord, Int -> Packing -> ShowS
[Packing] -> ShowS
Packing -> String
(Int -> Packing -> ShowS)
-> (Packing -> String) -> ([Packing] -> ShowS) -> Show Packing
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Packing] -> ShowS
$cshowList :: [Packing] -> ShowS
show :: Packing -> String
$cshow :: Packing -> String
showsPrec :: Int -> Packing -> ShowS
$cshowsPrec :: Int -> Packing -> ShowS
Show)

instance Arbitrary Packing where
  arbitrary :: Gen Packing
arbitrary = [Packing] -> Gen Packing
forall a. [a] -> Gen a
elements [Packing
PackedField, Packing
UnpackedField]

-- | This type is an almagamation of the modifiers used in types.
--   It corresponds to a syntax role but not a semantic role, not all modifiers
--   are meaningful in every type context.
data DotProtoType
  = Prim           DotProtoPrimType
  | Repeated       DotProtoPrimType
  | NestedRepeated DotProtoPrimType
  | Map            DotProtoPrimType DotProtoPrimType
  deriving (Typeable DotProtoType
DataType
Constr
Typeable DotProtoType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DotProtoType -> c DotProtoType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DotProtoType)
-> (DotProtoType -> Constr)
-> (DotProtoType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DotProtoType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DotProtoType))
-> ((forall b. Data b => b -> b) -> DotProtoType -> DotProtoType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DotProtoType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DotProtoType -> r)
-> (forall u. (forall d. Data d => d -> u) -> DotProtoType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DotProtoType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DotProtoType -> m DotProtoType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DotProtoType -> m DotProtoType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DotProtoType -> m DotProtoType)
-> Data DotProtoType
DotProtoType -> DataType
DotProtoType -> Constr
(forall b. Data b => b -> b) -> DotProtoType -> DotProtoType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProtoType -> c DotProtoType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoType
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) -> DotProtoType -> u
forall u. (forall d. Data d => d -> u) -> DotProtoType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DotProtoType -> m DotProtoType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DotProtoType -> m DotProtoType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProtoType -> c DotProtoType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DotProtoType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoType)
$cMap :: Constr
$cNestedRepeated :: Constr
$cRepeated :: Constr
$cPrim :: Constr
$tDotProtoType :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> DotProtoType -> m DotProtoType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DotProtoType -> m DotProtoType
gmapMp :: (forall d. Data d => d -> m d) -> DotProtoType -> m DotProtoType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DotProtoType -> m DotProtoType
gmapM :: (forall d. Data d => d -> m d) -> DotProtoType -> m DotProtoType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DotProtoType -> m DotProtoType
gmapQi :: Int -> (forall d. Data d => d -> u) -> DotProtoType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DotProtoType -> u
gmapQ :: (forall d. Data d => d -> u) -> DotProtoType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DotProtoType -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoType -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoType -> r
gmapT :: (forall b. Data b => b -> b) -> DotProtoType -> DotProtoType
$cgmapT :: (forall b. Data b => b -> b) -> DotProtoType -> DotProtoType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DotProtoType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DotProtoType)
dataTypeOf :: DotProtoType -> DataType
$cdataTypeOf :: DotProtoType -> DataType
toConstr :: DotProtoType -> Constr
$ctoConstr :: DotProtoType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProtoType -> c DotProtoType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProtoType -> c DotProtoType
$cp1Data :: Typeable DotProtoType
Data, DotProtoType -> DotProtoType -> Bool
(DotProtoType -> DotProtoType -> Bool)
-> (DotProtoType -> DotProtoType -> Bool) -> Eq DotProtoType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DotProtoType -> DotProtoType -> Bool
$c/= :: DotProtoType -> DotProtoType -> Bool
== :: DotProtoType -> DotProtoType -> Bool
$c== :: DotProtoType -> DotProtoType -> Bool
Eq, (forall x. DotProtoType -> Rep DotProtoType x)
-> (forall x. Rep DotProtoType x -> DotProtoType)
-> Generic DotProtoType
forall x. Rep DotProtoType x -> DotProtoType
forall x. DotProtoType -> Rep DotProtoType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DotProtoType x -> DotProtoType
$cfrom :: forall x. DotProtoType -> Rep DotProtoType x
Generic, Eq DotProtoType
Eq DotProtoType
-> (DotProtoType -> DotProtoType -> Ordering)
-> (DotProtoType -> DotProtoType -> Bool)
-> (DotProtoType -> DotProtoType -> Bool)
-> (DotProtoType -> DotProtoType -> Bool)
-> (DotProtoType -> DotProtoType -> Bool)
-> (DotProtoType -> DotProtoType -> DotProtoType)
-> (DotProtoType -> DotProtoType -> DotProtoType)
-> Ord DotProtoType
DotProtoType -> DotProtoType -> Bool
DotProtoType -> DotProtoType -> Ordering
DotProtoType -> DotProtoType -> DotProtoType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DotProtoType -> DotProtoType -> DotProtoType
$cmin :: DotProtoType -> DotProtoType -> DotProtoType
max :: DotProtoType -> DotProtoType -> DotProtoType
$cmax :: DotProtoType -> DotProtoType -> DotProtoType
>= :: DotProtoType -> DotProtoType -> Bool
$c>= :: DotProtoType -> DotProtoType -> Bool
> :: DotProtoType -> DotProtoType -> Bool
$c> :: DotProtoType -> DotProtoType -> Bool
<= :: DotProtoType -> DotProtoType -> Bool
$c<= :: DotProtoType -> DotProtoType -> Bool
< :: DotProtoType -> DotProtoType -> Bool
$c< :: DotProtoType -> DotProtoType -> Bool
compare :: DotProtoType -> DotProtoType -> Ordering
$ccompare :: DotProtoType -> DotProtoType -> Ordering
$cp1Ord :: Eq DotProtoType
Ord, Int -> DotProtoType -> ShowS
[DotProtoType] -> ShowS
DotProtoType -> String
(Int -> DotProtoType -> ShowS)
-> (DotProtoType -> String)
-> ([DotProtoType] -> ShowS)
-> Show DotProtoType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DotProtoType] -> ShowS
$cshowList :: [DotProtoType] -> ShowS
show :: DotProtoType -> String
$cshow :: DotProtoType -> String
showsPrec :: Int -> DotProtoType -> ShowS
$cshowsPrec :: Int -> DotProtoType -> ShowS
Show)

instance Arbitrary DotProtoType where
  arbitrary :: Gen DotProtoType
arbitrary = [Gen DotProtoType] -> Gen DotProtoType
forall a. [Gen a] -> Gen a
oneof [(DotProtoPrimType -> DotProtoType)
-> Gen DotProtoPrimType -> Gen DotProtoType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DotProtoPrimType -> DotProtoType
Prim Gen DotProtoPrimType
forall a. Arbitrary a => Gen a
arbitrary]

type DotProtoEnumValue = Int32

data DotProtoEnumPart
  = DotProtoEnumField DotProtoIdentifier DotProtoEnumValue [DotProtoOption]
  | DotProtoEnumOption DotProtoOption
  | DotProtoEnumEmpty
  deriving (Typeable DotProtoEnumPart
DataType
Constr
Typeable DotProtoEnumPart
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DotProtoEnumPart -> c DotProtoEnumPart)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DotProtoEnumPart)
-> (DotProtoEnumPart -> Constr)
-> (DotProtoEnumPart -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DotProtoEnumPart))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DotProtoEnumPart))
-> ((forall b. Data b => b -> b)
    -> DotProtoEnumPart -> DotProtoEnumPart)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DotProtoEnumPart -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DotProtoEnumPart -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> DotProtoEnumPart -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DotProtoEnumPart -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DotProtoEnumPart -> m DotProtoEnumPart)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DotProtoEnumPart -> m DotProtoEnumPart)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DotProtoEnumPart -> m DotProtoEnumPart)
-> Data DotProtoEnumPart
DotProtoEnumPart -> DataType
DotProtoEnumPart -> Constr
(forall b. Data b => b -> b)
-> DotProtoEnumPart -> DotProtoEnumPart
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProtoEnumPart -> c DotProtoEnumPart
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoEnumPart
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) -> DotProtoEnumPart -> u
forall u. (forall d. Data d => d -> u) -> DotProtoEnumPart -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoEnumPart -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoEnumPart -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DotProtoEnumPart -> m DotProtoEnumPart
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DotProtoEnumPart -> m DotProtoEnumPart
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoEnumPart
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProtoEnumPart -> c DotProtoEnumPart
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DotProtoEnumPart)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoEnumPart)
$cDotProtoEnumEmpty :: Constr
$cDotProtoEnumOption :: Constr
$cDotProtoEnumField :: Constr
$tDotProtoEnumPart :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> DotProtoEnumPart -> m DotProtoEnumPart
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DotProtoEnumPart -> m DotProtoEnumPart
gmapMp :: (forall d. Data d => d -> m d)
-> DotProtoEnumPart -> m DotProtoEnumPart
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DotProtoEnumPart -> m DotProtoEnumPart
gmapM :: (forall d. Data d => d -> m d)
-> DotProtoEnumPart -> m DotProtoEnumPart
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DotProtoEnumPart -> m DotProtoEnumPart
gmapQi :: Int -> (forall d. Data d => d -> u) -> DotProtoEnumPart -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DotProtoEnumPart -> u
gmapQ :: (forall d. Data d => d -> u) -> DotProtoEnumPart -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DotProtoEnumPart -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoEnumPart -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoEnumPart -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoEnumPart -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoEnumPart -> r
gmapT :: (forall b. Data b => b -> b)
-> DotProtoEnumPart -> DotProtoEnumPart
$cgmapT :: (forall b. Data b => b -> b)
-> DotProtoEnumPart -> DotProtoEnumPart
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoEnumPart)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoEnumPart)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DotProtoEnumPart)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DotProtoEnumPart)
dataTypeOf :: DotProtoEnumPart -> DataType
$cdataTypeOf :: DotProtoEnumPart -> DataType
toConstr :: DotProtoEnumPart -> Constr
$ctoConstr :: DotProtoEnumPart -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoEnumPart
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoEnumPart
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProtoEnumPart -> c DotProtoEnumPart
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProtoEnumPart -> c DotProtoEnumPart
$cp1Data :: Typeable DotProtoEnumPart
Data, DotProtoEnumPart -> DotProtoEnumPart -> Bool
(DotProtoEnumPart -> DotProtoEnumPart -> Bool)
-> (DotProtoEnumPart -> DotProtoEnumPart -> Bool)
-> Eq DotProtoEnumPart
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DotProtoEnumPart -> DotProtoEnumPart -> Bool
$c/= :: DotProtoEnumPart -> DotProtoEnumPart -> Bool
== :: DotProtoEnumPart -> DotProtoEnumPart -> Bool
$c== :: DotProtoEnumPart -> DotProtoEnumPart -> Bool
Eq, (forall x. DotProtoEnumPart -> Rep DotProtoEnumPart x)
-> (forall x. Rep DotProtoEnumPart x -> DotProtoEnumPart)
-> Generic DotProtoEnumPart
forall x. Rep DotProtoEnumPart x -> DotProtoEnumPart
forall x. DotProtoEnumPart -> Rep DotProtoEnumPart x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DotProtoEnumPart x -> DotProtoEnumPart
$cfrom :: forall x. DotProtoEnumPart -> Rep DotProtoEnumPart x
Generic, Eq DotProtoEnumPart
Eq DotProtoEnumPart
-> (DotProtoEnumPart -> DotProtoEnumPart -> Ordering)
-> (DotProtoEnumPart -> DotProtoEnumPart -> Bool)
-> (DotProtoEnumPart -> DotProtoEnumPart -> Bool)
-> (DotProtoEnumPart -> DotProtoEnumPart -> Bool)
-> (DotProtoEnumPart -> DotProtoEnumPart -> Bool)
-> (DotProtoEnumPart -> DotProtoEnumPart -> DotProtoEnumPart)
-> (DotProtoEnumPart -> DotProtoEnumPart -> DotProtoEnumPart)
-> Ord DotProtoEnumPart
DotProtoEnumPart -> DotProtoEnumPart -> Bool
DotProtoEnumPart -> DotProtoEnumPart -> Ordering
DotProtoEnumPart -> DotProtoEnumPart -> DotProtoEnumPart
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DotProtoEnumPart -> DotProtoEnumPart -> DotProtoEnumPart
$cmin :: DotProtoEnumPart -> DotProtoEnumPart -> DotProtoEnumPart
max :: DotProtoEnumPart -> DotProtoEnumPart -> DotProtoEnumPart
$cmax :: DotProtoEnumPart -> DotProtoEnumPart -> DotProtoEnumPart
>= :: DotProtoEnumPart -> DotProtoEnumPart -> Bool
$c>= :: DotProtoEnumPart -> DotProtoEnumPart -> Bool
> :: DotProtoEnumPart -> DotProtoEnumPart -> Bool
$c> :: DotProtoEnumPart -> DotProtoEnumPart -> Bool
<= :: DotProtoEnumPart -> DotProtoEnumPart -> Bool
$c<= :: DotProtoEnumPart -> DotProtoEnumPart -> Bool
< :: DotProtoEnumPart -> DotProtoEnumPart -> Bool
$c< :: DotProtoEnumPart -> DotProtoEnumPart -> Bool
compare :: DotProtoEnumPart -> DotProtoEnumPart -> Ordering
$ccompare :: DotProtoEnumPart -> DotProtoEnumPart -> Ordering
$cp1Ord :: Eq DotProtoEnumPart
Ord, Int -> DotProtoEnumPart -> ShowS
[DotProtoEnumPart] -> ShowS
DotProtoEnumPart -> String
(Int -> DotProtoEnumPart -> ShowS)
-> (DotProtoEnumPart -> String)
-> ([DotProtoEnumPart] -> ShowS)
-> Show DotProtoEnumPart
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DotProtoEnumPart] -> ShowS
$cshowList :: [DotProtoEnumPart] -> ShowS
show :: DotProtoEnumPart -> String
$cshow :: DotProtoEnumPart -> String
showsPrec :: Int -> DotProtoEnumPart -> ShowS
$cshowsPrec :: Int -> DotProtoEnumPart -> ShowS
Show)

instance Arbitrary DotProtoEnumPart where
  arbitrary :: Gen DotProtoEnumPart
arbitrary = [Gen DotProtoEnumPart] -> Gen DotProtoEnumPart
forall a. [Gen a] -> Gen a
oneof [Gen DotProtoEnumPart
arbitraryField, Gen DotProtoEnumPart
arbitraryOption]
    where
      arbitraryField :: Gen DotProtoEnumPart
arbitraryField = do
        DotProtoIdentifier
identifier <- Gen DotProtoIdentifier
arbitraryIdentifier
        DotProtoEnumValue
enumValue  <- Gen DotProtoEnumValue
forall a. Arbitrary a => Gen a
arbitrary
        [DotProtoOption]
opts       <- Gen [DotProtoOption]
forall a. Arbitrary a => Gen a
arbitrary
        DotProtoEnumPart -> Gen DotProtoEnumPart
forall (m :: * -> *) a. Monad m => a -> m a
return (DotProtoIdentifier
-> DotProtoEnumValue -> [DotProtoOption] -> DotProtoEnumPart
DotProtoEnumField DotProtoIdentifier
identifier DotProtoEnumValue
enumValue [DotProtoOption]
opts)

      arbitraryOption :: Gen DotProtoEnumPart
arbitraryOption = do
        DotProtoOption
option <- Gen DotProtoOption
forall a. Arbitrary a => Gen a
arbitrary
        DotProtoEnumPart -> Gen DotProtoEnumPart
forall (m :: * -> *) a. Monad m => a -> m a
return (DotProtoOption -> DotProtoEnumPart
DotProtoEnumOption DotProtoOption
option)

data Streaming
  = Streaming
  | NonStreaming
  deriving (Streaming
Streaming -> Streaming -> Bounded Streaming
forall a. a -> a -> Bounded a
maxBound :: Streaming
$cmaxBound :: Streaming
minBound :: Streaming
$cminBound :: Streaming
Bounded, Typeable Streaming
DataType
Constr
Typeable Streaming
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Streaming -> c Streaming)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Streaming)
-> (Streaming -> Constr)
-> (Streaming -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Streaming))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Streaming))
-> ((forall b. Data b => b -> b) -> Streaming -> Streaming)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Streaming -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Streaming -> r)
-> (forall u. (forall d. Data d => d -> u) -> Streaming -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Streaming -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Streaming -> m Streaming)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Streaming -> m Streaming)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Streaming -> m Streaming)
-> Data Streaming
Streaming -> DataType
Streaming -> Constr
(forall b. Data b => b -> b) -> Streaming -> Streaming
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Streaming -> c Streaming
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Streaming
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) -> Streaming -> u
forall u. (forall d. Data d => d -> u) -> Streaming -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Streaming -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Streaming -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Streaming -> m Streaming
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Streaming -> m Streaming
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Streaming
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Streaming -> c Streaming
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Streaming)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Streaming)
$cNonStreaming :: Constr
$cStreaming :: Constr
$tStreaming :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Streaming -> m Streaming
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Streaming -> m Streaming
gmapMp :: (forall d. Data d => d -> m d) -> Streaming -> m Streaming
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Streaming -> m Streaming
gmapM :: (forall d. Data d => d -> m d) -> Streaming -> m Streaming
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Streaming -> m Streaming
gmapQi :: Int -> (forall d. Data d => d -> u) -> Streaming -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Streaming -> u
gmapQ :: (forall d. Data d => d -> u) -> Streaming -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Streaming -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Streaming -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Streaming -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Streaming -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Streaming -> r
gmapT :: (forall b. Data b => b -> b) -> Streaming -> Streaming
$cgmapT :: (forall b. Data b => b -> b) -> Streaming -> Streaming
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Streaming)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Streaming)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Streaming)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Streaming)
dataTypeOf :: Streaming -> DataType
$cdataTypeOf :: Streaming -> DataType
toConstr :: Streaming -> Constr
$ctoConstr :: Streaming -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Streaming
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Streaming
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Streaming -> c Streaming
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Streaming -> c Streaming
$cp1Data :: Typeable Streaming
Data, Int -> Streaming
Streaming -> Int
Streaming -> [Streaming]
Streaming -> Streaming
Streaming -> Streaming -> [Streaming]
Streaming -> Streaming -> Streaming -> [Streaming]
(Streaming -> Streaming)
-> (Streaming -> Streaming)
-> (Int -> Streaming)
-> (Streaming -> Int)
-> (Streaming -> [Streaming])
-> (Streaming -> Streaming -> [Streaming])
-> (Streaming -> Streaming -> [Streaming])
-> (Streaming -> Streaming -> Streaming -> [Streaming])
-> Enum Streaming
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Streaming -> Streaming -> Streaming -> [Streaming]
$cenumFromThenTo :: Streaming -> Streaming -> Streaming -> [Streaming]
enumFromTo :: Streaming -> Streaming -> [Streaming]
$cenumFromTo :: Streaming -> Streaming -> [Streaming]
enumFromThen :: Streaming -> Streaming -> [Streaming]
$cenumFromThen :: Streaming -> Streaming -> [Streaming]
enumFrom :: Streaming -> [Streaming]
$cenumFrom :: Streaming -> [Streaming]
fromEnum :: Streaming -> Int
$cfromEnum :: Streaming -> Int
toEnum :: Int -> Streaming
$ctoEnum :: Int -> Streaming
pred :: Streaming -> Streaming
$cpred :: Streaming -> Streaming
succ :: Streaming -> Streaming
$csucc :: Streaming -> Streaming
Enum, Streaming -> Streaming -> Bool
(Streaming -> Streaming -> Bool)
-> (Streaming -> Streaming -> Bool) -> Eq Streaming
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Streaming -> Streaming -> Bool
$c/= :: Streaming -> Streaming -> Bool
== :: Streaming -> Streaming -> Bool
$c== :: Streaming -> Streaming -> Bool
Eq, (forall x. Streaming -> Rep Streaming x)
-> (forall x. Rep Streaming x -> Streaming) -> Generic Streaming
forall x. Rep Streaming x -> Streaming
forall x. Streaming -> Rep Streaming x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Streaming x -> Streaming
$cfrom :: forall x. Streaming -> Rep Streaming x
Generic, Eq Streaming
Eq Streaming
-> (Streaming -> Streaming -> Ordering)
-> (Streaming -> Streaming -> Bool)
-> (Streaming -> Streaming -> Bool)
-> (Streaming -> Streaming -> Bool)
-> (Streaming -> Streaming -> Bool)
-> (Streaming -> Streaming -> Streaming)
-> (Streaming -> Streaming -> Streaming)
-> Ord Streaming
Streaming -> Streaming -> Bool
Streaming -> Streaming -> Ordering
Streaming -> Streaming -> Streaming
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Streaming -> Streaming -> Streaming
$cmin :: Streaming -> Streaming -> Streaming
max :: Streaming -> Streaming -> Streaming
$cmax :: Streaming -> Streaming -> Streaming
>= :: Streaming -> Streaming -> Bool
$c>= :: Streaming -> Streaming -> Bool
> :: Streaming -> Streaming -> Bool
$c> :: Streaming -> Streaming -> Bool
<= :: Streaming -> Streaming -> Bool
$c<= :: Streaming -> Streaming -> Bool
< :: Streaming -> Streaming -> Bool
$c< :: Streaming -> Streaming -> Bool
compare :: Streaming -> Streaming -> Ordering
$ccompare :: Streaming -> Streaming -> Ordering
$cp1Ord :: Eq Streaming
Ord, Int -> Streaming -> ShowS
[Streaming] -> ShowS
Streaming -> String
(Int -> Streaming -> ShowS)
-> (Streaming -> String)
-> ([Streaming] -> ShowS)
-> Show Streaming
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Streaming] -> ShowS
$cshowList :: [Streaming] -> ShowS
show :: Streaming -> String
$cshow :: Streaming -> String
showsPrec :: Int -> Streaming -> ShowS
$cshowsPrec :: Int -> Streaming -> ShowS
Show)

instance Arbitrary Streaming where
  arbitrary :: Gen Streaming
arbitrary = [Streaming] -> Gen Streaming
forall a. [a] -> Gen a
elements [Streaming
Streaming, Streaming
NonStreaming]

data DotProtoServicePart
  = DotProtoServiceRPCMethod RPCMethod
  | DotProtoServiceOption DotProtoOption
  | DotProtoServiceEmpty
  deriving (Typeable DotProtoServicePart
DataType
Constr
Typeable DotProtoServicePart
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> DotProtoServicePart
    -> c DotProtoServicePart)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DotProtoServicePart)
-> (DotProtoServicePart -> Constr)
-> (DotProtoServicePart -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DotProtoServicePart))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DotProtoServicePart))
-> ((forall b. Data b => b -> b)
    -> DotProtoServicePart -> DotProtoServicePart)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DotProtoServicePart -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DotProtoServicePart -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> DotProtoServicePart -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DotProtoServicePart -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DotProtoServicePart -> m DotProtoServicePart)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DotProtoServicePart -> m DotProtoServicePart)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DotProtoServicePart -> m DotProtoServicePart)
-> Data DotProtoServicePart
DotProtoServicePart -> DataType
DotProtoServicePart -> Constr
(forall b. Data b => b -> b)
-> DotProtoServicePart -> DotProtoServicePart
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DotProtoServicePart
-> c DotProtoServicePart
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoServicePart
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) -> DotProtoServicePart -> u
forall u.
(forall d. Data d => d -> u) -> DotProtoServicePart -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoServicePart -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoServicePart -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DotProtoServicePart -> m DotProtoServicePart
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DotProtoServicePart -> m DotProtoServicePart
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoServicePart
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DotProtoServicePart
-> c DotProtoServicePart
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DotProtoServicePart)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoServicePart)
$cDotProtoServiceEmpty :: Constr
$cDotProtoServiceOption :: Constr
$cDotProtoServiceRPCMethod :: Constr
$tDotProtoServicePart :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> DotProtoServicePart -> m DotProtoServicePart
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DotProtoServicePart -> m DotProtoServicePart
gmapMp :: (forall d. Data d => d -> m d)
-> DotProtoServicePart -> m DotProtoServicePart
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DotProtoServicePart -> m DotProtoServicePart
gmapM :: (forall d. Data d => d -> m d)
-> DotProtoServicePart -> m DotProtoServicePart
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DotProtoServicePart -> m DotProtoServicePart
gmapQi :: Int -> (forall d. Data d => d -> u) -> DotProtoServicePart -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DotProtoServicePart -> u
gmapQ :: (forall d. Data d => d -> u) -> DotProtoServicePart -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> DotProtoServicePart -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoServicePart -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoServicePart -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoServicePart -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoServicePart -> r
gmapT :: (forall b. Data b => b -> b)
-> DotProtoServicePart -> DotProtoServicePart
$cgmapT :: (forall b. Data b => b -> b)
-> DotProtoServicePart -> DotProtoServicePart
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoServicePart)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoServicePart)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DotProtoServicePart)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DotProtoServicePart)
dataTypeOf :: DotProtoServicePart -> DataType
$cdataTypeOf :: DotProtoServicePart -> DataType
toConstr :: DotProtoServicePart -> Constr
$ctoConstr :: DotProtoServicePart -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoServicePart
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoServicePart
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DotProtoServicePart
-> c DotProtoServicePart
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DotProtoServicePart
-> c DotProtoServicePart
$cp1Data :: Typeable DotProtoServicePart
Data, DotProtoServicePart -> DotProtoServicePart -> Bool
(DotProtoServicePart -> DotProtoServicePart -> Bool)
-> (DotProtoServicePart -> DotProtoServicePart -> Bool)
-> Eq DotProtoServicePart
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DotProtoServicePart -> DotProtoServicePart -> Bool
$c/= :: DotProtoServicePart -> DotProtoServicePart -> Bool
== :: DotProtoServicePart -> DotProtoServicePart -> Bool
$c== :: DotProtoServicePart -> DotProtoServicePart -> Bool
Eq, (forall x. DotProtoServicePart -> Rep DotProtoServicePart x)
-> (forall x. Rep DotProtoServicePart x -> DotProtoServicePart)
-> Generic DotProtoServicePart
forall x. Rep DotProtoServicePart x -> DotProtoServicePart
forall x. DotProtoServicePart -> Rep DotProtoServicePart x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DotProtoServicePart x -> DotProtoServicePart
$cfrom :: forall x. DotProtoServicePart -> Rep DotProtoServicePart x
Generic, Eq DotProtoServicePart
Eq DotProtoServicePart
-> (DotProtoServicePart -> DotProtoServicePart -> Ordering)
-> (DotProtoServicePart -> DotProtoServicePart -> Bool)
-> (DotProtoServicePart -> DotProtoServicePart -> Bool)
-> (DotProtoServicePart -> DotProtoServicePart -> Bool)
-> (DotProtoServicePart -> DotProtoServicePart -> Bool)
-> (DotProtoServicePart
    -> DotProtoServicePart -> DotProtoServicePart)
-> (DotProtoServicePart
    -> DotProtoServicePart -> DotProtoServicePart)
-> Ord DotProtoServicePart
DotProtoServicePart -> DotProtoServicePart -> Bool
DotProtoServicePart -> DotProtoServicePart -> Ordering
DotProtoServicePart -> DotProtoServicePart -> DotProtoServicePart
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DotProtoServicePart -> DotProtoServicePart -> DotProtoServicePart
$cmin :: DotProtoServicePart -> DotProtoServicePart -> DotProtoServicePart
max :: DotProtoServicePart -> DotProtoServicePart -> DotProtoServicePart
$cmax :: DotProtoServicePart -> DotProtoServicePart -> DotProtoServicePart
>= :: DotProtoServicePart -> DotProtoServicePart -> Bool
$c>= :: DotProtoServicePart -> DotProtoServicePart -> Bool
> :: DotProtoServicePart -> DotProtoServicePart -> Bool
$c> :: DotProtoServicePart -> DotProtoServicePart -> Bool
<= :: DotProtoServicePart -> DotProtoServicePart -> Bool
$c<= :: DotProtoServicePart -> DotProtoServicePart -> Bool
< :: DotProtoServicePart -> DotProtoServicePart -> Bool
$c< :: DotProtoServicePart -> DotProtoServicePart -> Bool
compare :: DotProtoServicePart -> DotProtoServicePart -> Ordering
$ccompare :: DotProtoServicePart -> DotProtoServicePart -> Ordering
$cp1Ord :: Eq DotProtoServicePart
Ord, Int -> DotProtoServicePart -> ShowS
[DotProtoServicePart] -> ShowS
DotProtoServicePart -> String
(Int -> DotProtoServicePart -> ShowS)
-> (DotProtoServicePart -> String)
-> ([DotProtoServicePart] -> ShowS)
-> Show DotProtoServicePart
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DotProtoServicePart] -> ShowS
$cshowList :: [DotProtoServicePart] -> ShowS
show :: DotProtoServicePart -> String
$cshow :: DotProtoServicePart -> String
showsPrec :: Int -> DotProtoServicePart -> ShowS
$cshowsPrec :: Int -> DotProtoServicePart -> ShowS
Show)

instance Arbitrary DotProtoServicePart where
  arbitrary :: Gen DotProtoServicePart
arbitrary = [Gen DotProtoServicePart] -> Gen DotProtoServicePart
forall a. [Gen a] -> Gen a
oneof
    [ RPCMethod -> DotProtoServicePart
DotProtoServiceRPCMethod (RPCMethod -> DotProtoServicePart)
-> Gen RPCMethod -> Gen DotProtoServicePart
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen RPCMethod
forall a. Arbitrary a => Gen a
arbitrary
    , DotProtoOption -> DotProtoServicePart
DotProtoServiceOption (DotProtoOption -> DotProtoServicePart)
-> Gen DotProtoOption -> Gen DotProtoServicePart
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen DotProtoOption
forall a. Arbitrary a => Gen a
arbitrary
    ]

data RPCMethod = RPCMethod
  { RPCMethod -> DotProtoIdentifier
rpcMethodName :: DotProtoIdentifier
  , RPCMethod -> DotProtoIdentifier
rpcMethodRequestType :: DotProtoIdentifier
  , RPCMethod -> Streaming
rpcMethodRequestStreaming :: Streaming
  , RPCMethod -> DotProtoIdentifier
rpcMethodResponseType :: DotProtoIdentifier
  , RPCMethod -> Streaming
rpcMethodResponseStreaming :: Streaming
  , RPCMethod -> [DotProtoOption]
rpcMethodOptions :: [DotProtoOption]
  } 
  deriving (Typeable RPCMethod
DataType
Constr
Typeable RPCMethod
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> RPCMethod -> c RPCMethod)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RPCMethod)
-> (RPCMethod -> Constr)
-> (RPCMethod -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RPCMethod))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RPCMethod))
-> ((forall b. Data b => b -> b) -> RPCMethod -> RPCMethod)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RPCMethod -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RPCMethod -> r)
-> (forall u. (forall d. Data d => d -> u) -> RPCMethod -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RPCMethod -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RPCMethod -> m RPCMethod)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RPCMethod -> m RPCMethod)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RPCMethod -> m RPCMethod)
-> Data RPCMethod
RPCMethod -> DataType
RPCMethod -> Constr
(forall b. Data b => b -> b) -> RPCMethod -> RPCMethod
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RPCMethod -> c RPCMethod
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RPCMethod
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) -> RPCMethod -> u
forall u. (forall d. Data d => d -> u) -> RPCMethod -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RPCMethod -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RPCMethod -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RPCMethod -> m RPCMethod
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RPCMethod -> m RPCMethod
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RPCMethod
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RPCMethod -> c RPCMethod
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RPCMethod)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RPCMethod)
$cRPCMethod :: Constr
$tRPCMethod :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> RPCMethod -> m RPCMethod
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RPCMethod -> m RPCMethod
gmapMp :: (forall d. Data d => d -> m d) -> RPCMethod -> m RPCMethod
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RPCMethod -> m RPCMethod
gmapM :: (forall d. Data d => d -> m d) -> RPCMethod -> m RPCMethod
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RPCMethod -> m RPCMethod
gmapQi :: Int -> (forall d. Data d => d -> u) -> RPCMethod -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RPCMethod -> u
gmapQ :: (forall d. Data d => d -> u) -> RPCMethod -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RPCMethod -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RPCMethod -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RPCMethod -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RPCMethod -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RPCMethod -> r
gmapT :: (forall b. Data b => b -> b) -> RPCMethod -> RPCMethod
$cgmapT :: (forall b. Data b => b -> b) -> RPCMethod -> RPCMethod
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RPCMethod)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RPCMethod)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RPCMethod)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RPCMethod)
dataTypeOf :: RPCMethod -> DataType
$cdataTypeOf :: RPCMethod -> DataType
toConstr :: RPCMethod -> Constr
$ctoConstr :: RPCMethod -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RPCMethod
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RPCMethod
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RPCMethod -> c RPCMethod
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RPCMethod -> c RPCMethod
$cp1Data :: Typeable RPCMethod
Data, RPCMethod -> RPCMethod -> Bool
(RPCMethod -> RPCMethod -> Bool)
-> (RPCMethod -> RPCMethod -> Bool) -> Eq RPCMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RPCMethod -> RPCMethod -> Bool
$c/= :: RPCMethod -> RPCMethod -> Bool
== :: RPCMethod -> RPCMethod -> Bool
$c== :: RPCMethod -> RPCMethod -> Bool
Eq, (forall x. RPCMethod -> Rep RPCMethod x)
-> (forall x. Rep RPCMethod x -> RPCMethod) -> Generic RPCMethod
forall x. Rep RPCMethod x -> RPCMethod
forall x. RPCMethod -> Rep RPCMethod x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RPCMethod x -> RPCMethod
$cfrom :: forall x. RPCMethod -> Rep RPCMethod x
Generic, Eq RPCMethod
Eq RPCMethod
-> (RPCMethod -> RPCMethod -> Ordering)
-> (RPCMethod -> RPCMethod -> Bool)
-> (RPCMethod -> RPCMethod -> Bool)
-> (RPCMethod -> RPCMethod -> Bool)
-> (RPCMethod -> RPCMethod -> Bool)
-> (RPCMethod -> RPCMethod -> RPCMethod)
-> (RPCMethod -> RPCMethod -> RPCMethod)
-> Ord RPCMethod
RPCMethod -> RPCMethod -> Bool
RPCMethod -> RPCMethod -> Ordering
RPCMethod -> RPCMethod -> RPCMethod
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RPCMethod -> RPCMethod -> RPCMethod
$cmin :: RPCMethod -> RPCMethod -> RPCMethod
max :: RPCMethod -> RPCMethod -> RPCMethod
$cmax :: RPCMethod -> RPCMethod -> RPCMethod
>= :: RPCMethod -> RPCMethod -> Bool
$c>= :: RPCMethod -> RPCMethod -> Bool
> :: RPCMethod -> RPCMethod -> Bool
$c> :: RPCMethod -> RPCMethod -> Bool
<= :: RPCMethod -> RPCMethod -> Bool
$c<= :: RPCMethod -> RPCMethod -> Bool
< :: RPCMethod -> RPCMethod -> Bool
$c< :: RPCMethod -> RPCMethod -> Bool
compare :: RPCMethod -> RPCMethod -> Ordering
$ccompare :: RPCMethod -> RPCMethod -> Ordering
$cp1Ord :: Eq RPCMethod
Ord, Int -> RPCMethod -> ShowS
[RPCMethod] -> ShowS
RPCMethod -> String
(Int -> RPCMethod -> ShowS)
-> (RPCMethod -> String)
-> ([RPCMethod] -> ShowS)
-> Show RPCMethod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RPCMethod] -> ShowS
$cshowList :: [RPCMethod] -> ShowS
show :: RPCMethod -> String
$cshow :: RPCMethod -> String
showsPrec :: Int -> RPCMethod -> ShowS
$cshowsPrec :: Int -> RPCMethod -> ShowS
Show)

instance Arbitrary RPCMethod where
  arbitrary :: Gen RPCMethod
arbitrary = do
    DotProtoIdentifier
rpcMethodName <- Gen DotProtoIdentifier
arbitrarySingleIdentifier
    DotProtoIdentifier
rpcMethodRequestType <- Gen DotProtoIdentifier
arbitraryIdentifier
    Streaming
rpcMethodRequestStreaming  <- Gen Streaming
forall a. Arbitrary a => Gen a
arbitrary
    DotProtoIdentifier
rpcMethodResponseType <- Gen DotProtoIdentifier
arbitraryIdentifier
    Streaming
rpcMethodResponseStreaming  <- Gen Streaming
forall a. Arbitrary a => Gen a
arbitrary
    [DotProtoOption]
rpcMethodOptions <- Gen DotProtoOption -> Gen [DotProtoOption]
forall a. Gen a -> Gen [a]
smallListOf Gen DotProtoOption
forall a. Arbitrary a => Gen a
arbitrary
    RPCMethod -> Gen RPCMethod
forall (m :: * -> *) a. Monad m => a -> m a
return RPCMethod :: DotProtoIdentifier
-> DotProtoIdentifier
-> Streaming
-> DotProtoIdentifier
-> Streaming
-> [DotProtoOption]
-> RPCMethod
RPCMethod{[DotProtoOption]
Streaming
DotProtoIdentifier
rpcMethodOptions :: [DotProtoOption]
rpcMethodResponseStreaming :: Streaming
rpcMethodResponseType :: DotProtoIdentifier
rpcMethodRequestStreaming :: Streaming
rpcMethodRequestType :: DotProtoIdentifier
rpcMethodName :: DotProtoIdentifier
rpcMethodOptions :: [DotProtoOption]
rpcMethodResponseStreaming :: Streaming
rpcMethodResponseType :: DotProtoIdentifier
rpcMethodRequestStreaming :: Streaming
rpcMethodRequestType :: DotProtoIdentifier
rpcMethodName :: DotProtoIdentifier
..}

data DotProtoMessagePart
  = DotProtoMessageField DotProtoField
  | DotProtoMessageOneOf DotProtoIdentifier [DotProtoField]
  | DotProtoMessageDefinition DotProtoDefinition
  | DotProtoMessageReserved   [DotProtoReservedField]
  | DotProtoMessageOption DotProtoOption
  deriving (Typeable DotProtoMessagePart
DataType
Constr
Typeable DotProtoMessagePart
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> DotProtoMessagePart
    -> c DotProtoMessagePart)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DotProtoMessagePart)
-> (DotProtoMessagePart -> Constr)
-> (DotProtoMessagePart -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DotProtoMessagePart))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DotProtoMessagePart))
-> ((forall b. Data b => b -> b)
    -> DotProtoMessagePart -> DotProtoMessagePart)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DotProtoMessagePart -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DotProtoMessagePart -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> DotProtoMessagePart -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DotProtoMessagePart -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DotProtoMessagePart -> m DotProtoMessagePart)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DotProtoMessagePart -> m DotProtoMessagePart)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DotProtoMessagePart -> m DotProtoMessagePart)
-> Data DotProtoMessagePart
DotProtoMessagePart -> DataType
DotProtoMessagePart -> Constr
(forall b. Data b => b -> b)
-> DotProtoMessagePart -> DotProtoMessagePart
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DotProtoMessagePart
-> c DotProtoMessagePart
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoMessagePart
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) -> DotProtoMessagePart -> u
forall u.
(forall d. Data d => d -> u) -> DotProtoMessagePart -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoMessagePart -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoMessagePart -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DotProtoMessagePart -> m DotProtoMessagePart
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DotProtoMessagePart -> m DotProtoMessagePart
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoMessagePart
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DotProtoMessagePart
-> c DotProtoMessagePart
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DotProtoMessagePart)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoMessagePart)
$cDotProtoMessageOption :: Constr
$cDotProtoMessageReserved :: Constr
$cDotProtoMessageDefinition :: Constr
$cDotProtoMessageOneOf :: Constr
$cDotProtoMessageField :: Constr
$tDotProtoMessagePart :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> DotProtoMessagePart -> m DotProtoMessagePart
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DotProtoMessagePart -> m DotProtoMessagePart
gmapMp :: (forall d. Data d => d -> m d)
-> DotProtoMessagePart -> m DotProtoMessagePart
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DotProtoMessagePart -> m DotProtoMessagePart
gmapM :: (forall d. Data d => d -> m d)
-> DotProtoMessagePart -> m DotProtoMessagePart
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DotProtoMessagePart -> m DotProtoMessagePart
gmapQi :: Int -> (forall d. Data d => d -> u) -> DotProtoMessagePart -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DotProtoMessagePart -> u
gmapQ :: (forall d. Data d => d -> u) -> DotProtoMessagePart -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> DotProtoMessagePart -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoMessagePart -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoMessagePart -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoMessagePart -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoMessagePart -> r
gmapT :: (forall b. Data b => b -> b)
-> DotProtoMessagePart -> DotProtoMessagePart
$cgmapT :: (forall b. Data b => b -> b)
-> DotProtoMessagePart -> DotProtoMessagePart
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoMessagePart)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoMessagePart)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DotProtoMessagePart)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DotProtoMessagePart)
dataTypeOf :: DotProtoMessagePart -> DataType
$cdataTypeOf :: DotProtoMessagePart -> DataType
toConstr :: DotProtoMessagePart -> Constr
$ctoConstr :: DotProtoMessagePart -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoMessagePart
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoMessagePart
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DotProtoMessagePart
-> c DotProtoMessagePart
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DotProtoMessagePart
-> c DotProtoMessagePart
$cp1Data :: Typeable DotProtoMessagePart
Data, DotProtoMessagePart -> DotProtoMessagePart -> Bool
(DotProtoMessagePart -> DotProtoMessagePart -> Bool)
-> (DotProtoMessagePart -> DotProtoMessagePart -> Bool)
-> Eq DotProtoMessagePart
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DotProtoMessagePart -> DotProtoMessagePart -> Bool
$c/= :: DotProtoMessagePart -> DotProtoMessagePart -> Bool
== :: DotProtoMessagePart -> DotProtoMessagePart -> Bool
$c== :: DotProtoMessagePart -> DotProtoMessagePart -> Bool
Eq, (forall x. DotProtoMessagePart -> Rep DotProtoMessagePart x)
-> (forall x. Rep DotProtoMessagePart x -> DotProtoMessagePart)
-> Generic DotProtoMessagePart
forall x. Rep DotProtoMessagePart x -> DotProtoMessagePart
forall x. DotProtoMessagePart -> Rep DotProtoMessagePart x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DotProtoMessagePart x -> DotProtoMessagePart
$cfrom :: forall x. DotProtoMessagePart -> Rep DotProtoMessagePart x
Generic, Eq DotProtoMessagePart
Eq DotProtoMessagePart
-> (DotProtoMessagePart -> DotProtoMessagePart -> Ordering)
-> (DotProtoMessagePart -> DotProtoMessagePart -> Bool)
-> (DotProtoMessagePart -> DotProtoMessagePart -> Bool)
-> (DotProtoMessagePart -> DotProtoMessagePart -> Bool)
-> (DotProtoMessagePart -> DotProtoMessagePart -> Bool)
-> (DotProtoMessagePart
    -> DotProtoMessagePart -> DotProtoMessagePart)
-> (DotProtoMessagePart
    -> DotProtoMessagePart -> DotProtoMessagePart)
-> Ord DotProtoMessagePart
DotProtoMessagePart -> DotProtoMessagePart -> Bool
DotProtoMessagePart -> DotProtoMessagePart -> Ordering
DotProtoMessagePart -> DotProtoMessagePart -> DotProtoMessagePart
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DotProtoMessagePart -> DotProtoMessagePart -> DotProtoMessagePart
$cmin :: DotProtoMessagePart -> DotProtoMessagePart -> DotProtoMessagePart
max :: DotProtoMessagePart -> DotProtoMessagePart -> DotProtoMessagePart
$cmax :: DotProtoMessagePart -> DotProtoMessagePart -> DotProtoMessagePart
>= :: DotProtoMessagePart -> DotProtoMessagePart -> Bool
$c>= :: DotProtoMessagePart -> DotProtoMessagePart -> Bool
> :: DotProtoMessagePart -> DotProtoMessagePart -> Bool
$c> :: DotProtoMessagePart -> DotProtoMessagePart -> Bool
<= :: DotProtoMessagePart -> DotProtoMessagePart -> Bool
$c<= :: DotProtoMessagePart -> DotProtoMessagePart -> Bool
< :: DotProtoMessagePart -> DotProtoMessagePart -> Bool
$c< :: DotProtoMessagePart -> DotProtoMessagePart -> Bool
compare :: DotProtoMessagePart -> DotProtoMessagePart -> Ordering
$ccompare :: DotProtoMessagePart -> DotProtoMessagePart -> Ordering
$cp1Ord :: Eq DotProtoMessagePart
Ord, Int -> DotProtoMessagePart -> ShowS
[DotProtoMessagePart] -> ShowS
DotProtoMessagePart -> String
(Int -> DotProtoMessagePart -> ShowS)
-> (DotProtoMessagePart -> String)
-> ([DotProtoMessagePart] -> ShowS)
-> Show DotProtoMessagePart
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DotProtoMessagePart] -> ShowS
$cshowList :: [DotProtoMessagePart] -> ShowS
show :: DotProtoMessagePart -> String
$cshow :: DotProtoMessagePart -> String
showsPrec :: Int -> DotProtoMessagePart -> ShowS
$cshowsPrec :: Int -> DotProtoMessagePart -> ShowS
Show)

instance Arbitrary DotProtoMessagePart where
  arbitrary :: Gen DotProtoMessagePart
arbitrary = [Gen DotProtoMessagePart] -> Gen DotProtoMessagePart
forall a. [Gen a] -> Gen a
oneof
    [ Gen DotProtoMessagePart
arbitraryField
    , Gen DotProtoMessagePart
arbitraryOneOf
    , Gen DotProtoMessagePart
arbitraryDefinition
    , Gen DotProtoMessagePart
arbitraryReserved
    ]
    where
      arbitraryField :: Gen DotProtoMessagePart
arbitraryField = do
        DotProtoField
field <- Gen DotProtoField
forall a. Arbitrary a => Gen a
arbitrary
        DotProtoMessagePart -> Gen DotProtoMessagePart
forall (m :: * -> *) a. Monad m => a -> m a
return (DotProtoField -> DotProtoMessagePart
DotProtoMessageField DotProtoField
field)

      arbitraryOneOf :: Gen DotProtoMessagePart
arbitraryOneOf = do
        DotProtoIdentifier
name   <- Gen DotProtoIdentifier
arbitrarySingleIdentifier
        [DotProtoField]
fields <- Gen DotProtoField -> Gen [DotProtoField]
forall a. Gen a -> Gen [a]
smallListOf Gen DotProtoField
forall a. Arbitrary a => Gen a
arbitrary
        DotProtoMessagePart -> Gen DotProtoMessagePart
forall (m :: * -> *) a. Monad m => a -> m a
return (DotProtoIdentifier -> [DotProtoField] -> DotProtoMessagePart
DotProtoMessageOneOf DotProtoIdentifier
name [DotProtoField]
fields)

      arbitraryDefinition :: Gen DotProtoMessagePart
arbitraryDefinition = do
        DotProtoDefinition
definition <- Gen DotProtoDefinition
forall a. Arbitrary a => Gen a
arbitrary
        DotProtoMessagePart -> Gen DotProtoMessagePart
forall (m :: * -> *) a. Monad m => a -> m a
return (DotProtoDefinition -> DotProtoMessagePart
DotProtoMessageDefinition DotProtoDefinition
definition)

      arbitraryReserved :: Gen DotProtoMessagePart
arbitraryReserved = do
        [DotProtoReservedField]
fields <- [Gen [DotProtoReservedField]] -> Gen [DotProtoReservedField]
forall a. [Gen a] -> Gen a
oneof [Gen DotProtoReservedField -> Gen [DotProtoReservedField]
forall a. Gen a -> Gen [a]
smallListOf1 Gen DotProtoReservedField
forall a. Arbitrary a => Gen a
arbitrary, Gen [DotProtoReservedField]
arbitraryReservedLabels]
        DotProtoMessagePart -> Gen DotProtoMessagePart
forall (m :: * -> *) a. Monad m => a -> m a
return ([DotProtoReservedField] -> DotProtoMessagePart
DotProtoMessageReserved [DotProtoReservedField]
fields)

      arbitraryReservedLabels :: Gen [DotProtoReservedField]
      arbitraryReservedLabels :: Gen [DotProtoReservedField]
arbitraryReservedLabels =
          Gen DotProtoReservedField -> Gen [DotProtoReservedField]
forall a. Gen a -> Gen [a]
smallListOf1 (String -> DotProtoReservedField
ReservedIdentifier (String -> DotProtoReservedField)
-> Gen String -> Gen DotProtoReservedField
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
arbitraryIdentifierName)

data DotProtoField = DotProtoField
  { DotProtoField -> FieldNumber
dotProtoFieldNumber  :: FieldNumber
  , DotProtoField -> DotProtoType
dotProtoFieldType    :: DotProtoType
  , DotProtoField -> DotProtoIdentifier
dotProtoFieldName    :: DotProtoIdentifier
  , DotProtoField -> [DotProtoOption]
dotProtoFieldOptions :: [DotProtoOption]
  , DotProtoField -> String
dotProtoFieldComment :: String
  }
  | DotProtoEmptyField
  deriving (Typeable DotProtoField
DataType
Constr
Typeable DotProtoField
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DotProtoField -> c DotProtoField)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DotProtoField)
-> (DotProtoField -> Constr)
-> (DotProtoField -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DotProtoField))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DotProtoField))
-> ((forall b. Data b => b -> b) -> DotProtoField -> DotProtoField)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DotProtoField -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DotProtoField -> r)
-> (forall u. (forall d. Data d => d -> u) -> DotProtoField -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DotProtoField -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DotProtoField -> m DotProtoField)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DotProtoField -> m DotProtoField)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DotProtoField -> m DotProtoField)
-> Data DotProtoField
DotProtoField -> DataType
DotProtoField -> Constr
(forall b. Data b => b -> b) -> DotProtoField -> DotProtoField
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProtoField -> c DotProtoField
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoField
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) -> DotProtoField -> u
forall u. (forall d. Data d => d -> u) -> DotProtoField -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoField -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoField -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DotProtoField -> m DotProtoField
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DotProtoField -> m DotProtoField
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoField
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProtoField -> c DotProtoField
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DotProtoField)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoField)
$cDotProtoEmptyField :: Constr
$cDotProtoField :: Constr
$tDotProtoField :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> DotProtoField -> m DotProtoField
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DotProtoField -> m DotProtoField
gmapMp :: (forall d. Data d => d -> m d) -> DotProtoField -> m DotProtoField
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DotProtoField -> m DotProtoField
gmapM :: (forall d. Data d => d -> m d) -> DotProtoField -> m DotProtoField
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DotProtoField -> m DotProtoField
gmapQi :: Int -> (forall d. Data d => d -> u) -> DotProtoField -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DotProtoField -> u
gmapQ :: (forall d. Data d => d -> u) -> DotProtoField -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DotProtoField -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoField -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoField -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoField -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoField -> r
gmapT :: (forall b. Data b => b -> b) -> DotProtoField -> DotProtoField
$cgmapT :: (forall b. Data b => b -> b) -> DotProtoField -> DotProtoField
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoField)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoField)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DotProtoField)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DotProtoField)
dataTypeOf :: DotProtoField -> DataType
$cdataTypeOf :: DotProtoField -> DataType
toConstr :: DotProtoField -> Constr
$ctoConstr :: DotProtoField -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoField
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoField
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProtoField -> c DotProtoField
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DotProtoField -> c DotProtoField
$cp1Data :: Typeable DotProtoField
Data, DotProtoField -> DotProtoField -> Bool
(DotProtoField -> DotProtoField -> Bool)
-> (DotProtoField -> DotProtoField -> Bool) -> Eq DotProtoField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DotProtoField -> DotProtoField -> Bool
$c/= :: DotProtoField -> DotProtoField -> Bool
== :: DotProtoField -> DotProtoField -> Bool
$c== :: DotProtoField -> DotProtoField -> Bool
Eq, (forall x. DotProtoField -> Rep DotProtoField x)
-> (forall x. Rep DotProtoField x -> DotProtoField)
-> Generic DotProtoField
forall x. Rep DotProtoField x -> DotProtoField
forall x. DotProtoField -> Rep DotProtoField x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DotProtoField x -> DotProtoField
$cfrom :: forall x. DotProtoField -> Rep DotProtoField x
Generic, Eq DotProtoField
Eq DotProtoField
-> (DotProtoField -> DotProtoField -> Ordering)
-> (DotProtoField -> DotProtoField -> Bool)
-> (DotProtoField -> DotProtoField -> Bool)
-> (DotProtoField -> DotProtoField -> Bool)
-> (DotProtoField -> DotProtoField -> Bool)
-> (DotProtoField -> DotProtoField -> DotProtoField)
-> (DotProtoField -> DotProtoField -> DotProtoField)
-> Ord DotProtoField
DotProtoField -> DotProtoField -> Bool
DotProtoField -> DotProtoField -> Ordering
DotProtoField -> DotProtoField -> DotProtoField
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DotProtoField -> DotProtoField -> DotProtoField
$cmin :: DotProtoField -> DotProtoField -> DotProtoField
max :: DotProtoField -> DotProtoField -> DotProtoField
$cmax :: DotProtoField -> DotProtoField -> DotProtoField
>= :: DotProtoField -> DotProtoField -> Bool
$c>= :: DotProtoField -> DotProtoField -> Bool
> :: DotProtoField -> DotProtoField -> Bool
$c> :: DotProtoField -> DotProtoField -> Bool
<= :: DotProtoField -> DotProtoField -> Bool
$c<= :: DotProtoField -> DotProtoField -> Bool
< :: DotProtoField -> DotProtoField -> Bool
$c< :: DotProtoField -> DotProtoField -> Bool
compare :: DotProtoField -> DotProtoField -> Ordering
$ccompare :: DotProtoField -> DotProtoField -> Ordering
$cp1Ord :: Eq DotProtoField
Ord, Int -> DotProtoField -> ShowS
[DotProtoField] -> ShowS
DotProtoField -> String
(Int -> DotProtoField -> ShowS)
-> (DotProtoField -> String)
-> ([DotProtoField] -> ShowS)
-> Show DotProtoField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DotProtoField] -> ShowS
$cshowList :: [DotProtoField] -> ShowS
show :: DotProtoField -> String
$cshow :: DotProtoField -> String
showsPrec :: Int -> DotProtoField -> ShowS
$cshowsPrec :: Int -> DotProtoField -> ShowS
Show)

instance Arbitrary DotProtoField where
  arbitrary :: Gen DotProtoField
arbitrary = do
    FieldNumber
dotProtoFieldNumber  <- Gen FieldNumber
forall a. Arbitrary a => Gen a
arbitrary
    DotProtoType
dotProtoFieldType    <- Gen DotProtoType
forall a. Arbitrary a => Gen a
arbitrary
    DotProtoIdentifier
dotProtoFieldName    <- Gen DotProtoIdentifier
arbitraryIdentifier
    [DotProtoOption]
dotProtoFieldOptions <- Gen DotProtoOption -> Gen [DotProtoOption]
forall a. Gen a -> Gen [a]
smallListOf Gen DotProtoOption
forall a. Arbitrary a => Gen a
arbitrary
    -- TODO: Generate random comments once the parser supports comments
    String
dotProtoFieldComment <- String -> Gen String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
forall a. Monoid a => a
mempty
    DotProtoField -> Gen DotProtoField
forall (m :: * -> *) a. Monad m => a -> m a
return (DotProtoField :: FieldNumber
-> DotProtoType
-> DotProtoIdentifier
-> [DotProtoOption]
-> String
-> DotProtoField
DotProtoField {String
[DotProtoOption]
FieldNumber
DotProtoType
DotProtoIdentifier
dotProtoFieldComment :: String
dotProtoFieldOptions :: [DotProtoOption]
dotProtoFieldName :: DotProtoIdentifier
dotProtoFieldType :: DotProtoType
dotProtoFieldNumber :: FieldNumber
dotProtoFieldComment :: String
dotProtoFieldOptions :: [DotProtoOption]
dotProtoFieldName :: DotProtoIdentifier
dotProtoFieldType :: DotProtoType
dotProtoFieldNumber :: FieldNumber
..})

data DotProtoReservedField
  = SingleField Int
  | FieldRange  Int Int
  | ReservedIdentifier String
  deriving (Typeable DotProtoReservedField
DataType
Constr
Typeable DotProtoReservedField
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> DotProtoReservedField
    -> c DotProtoReservedField)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DotProtoReservedField)
-> (DotProtoReservedField -> Constr)
-> (DotProtoReservedField -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DotProtoReservedField))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DotProtoReservedField))
-> ((forall b. Data b => b -> b)
    -> DotProtoReservedField -> DotProtoReservedField)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> DotProtoReservedField
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> DotProtoReservedField
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> DotProtoReservedField -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DotProtoReservedField -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DotProtoReservedField -> m DotProtoReservedField)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DotProtoReservedField -> m DotProtoReservedField)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DotProtoReservedField -> m DotProtoReservedField)
-> Data DotProtoReservedField
DotProtoReservedField -> DataType
DotProtoReservedField -> Constr
(forall b. Data b => b -> b)
-> DotProtoReservedField -> DotProtoReservedField
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DotProtoReservedField
-> c DotProtoReservedField
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoReservedField
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) -> DotProtoReservedField -> u
forall u.
(forall d. Data d => d -> u) -> DotProtoReservedField -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoReservedField -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoReservedField -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DotProtoReservedField -> m DotProtoReservedField
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DotProtoReservedField -> m DotProtoReservedField
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoReservedField
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DotProtoReservedField
-> c DotProtoReservedField
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DotProtoReservedField)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoReservedField)
$cReservedIdentifier :: Constr
$cFieldRange :: Constr
$cSingleField :: Constr
$tDotProtoReservedField :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> DotProtoReservedField -> m DotProtoReservedField
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DotProtoReservedField -> m DotProtoReservedField
gmapMp :: (forall d. Data d => d -> m d)
-> DotProtoReservedField -> m DotProtoReservedField
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DotProtoReservedField -> m DotProtoReservedField
gmapM :: (forall d. Data d => d -> m d)
-> DotProtoReservedField -> m DotProtoReservedField
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DotProtoReservedField -> m DotProtoReservedField
gmapQi :: Int -> (forall d. Data d => d -> u) -> DotProtoReservedField -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DotProtoReservedField -> u
gmapQ :: (forall d. Data d => d -> u) -> DotProtoReservedField -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> DotProtoReservedField -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoReservedField -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoReservedField -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoReservedField -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DotProtoReservedField -> r
gmapT :: (forall b. Data b => b -> b)
-> DotProtoReservedField -> DotProtoReservedField
$cgmapT :: (forall b. Data b => b -> b)
-> DotProtoReservedField -> DotProtoReservedField
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoReservedField)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DotProtoReservedField)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DotProtoReservedField)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DotProtoReservedField)
dataTypeOf :: DotProtoReservedField -> DataType
$cdataTypeOf :: DotProtoReservedField -> DataType
toConstr :: DotProtoReservedField -> Constr
$ctoConstr :: DotProtoReservedField -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoReservedField
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DotProtoReservedField
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DotProtoReservedField
-> c DotProtoReservedField
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DotProtoReservedField
-> c DotProtoReservedField
$cp1Data :: Typeable DotProtoReservedField
Data, DotProtoReservedField -> DotProtoReservedField -> Bool
(DotProtoReservedField -> DotProtoReservedField -> Bool)
-> (DotProtoReservedField -> DotProtoReservedField -> Bool)
-> Eq DotProtoReservedField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DotProtoReservedField -> DotProtoReservedField -> Bool
$c/= :: DotProtoReservedField -> DotProtoReservedField -> Bool
== :: DotProtoReservedField -> DotProtoReservedField -> Bool
$c== :: DotProtoReservedField -> DotProtoReservedField -> Bool
Eq, (forall x. DotProtoReservedField -> Rep DotProtoReservedField x)
-> (forall x. Rep DotProtoReservedField x -> DotProtoReservedField)
-> Generic DotProtoReservedField
forall x. Rep DotProtoReservedField x -> DotProtoReservedField
forall x. DotProtoReservedField -> Rep DotProtoReservedField x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DotProtoReservedField x -> DotProtoReservedField
$cfrom :: forall x. DotProtoReservedField -> Rep DotProtoReservedField x
Generic, Eq DotProtoReservedField
Eq DotProtoReservedField
-> (DotProtoReservedField -> DotProtoReservedField -> Ordering)
-> (DotProtoReservedField -> DotProtoReservedField -> Bool)
-> (DotProtoReservedField -> DotProtoReservedField -> Bool)
-> (DotProtoReservedField -> DotProtoReservedField -> Bool)
-> (DotProtoReservedField -> DotProtoReservedField -> Bool)
-> (DotProtoReservedField
    -> DotProtoReservedField -> DotProtoReservedField)
-> (DotProtoReservedField
    -> DotProtoReservedField -> DotProtoReservedField)
-> Ord DotProtoReservedField
DotProtoReservedField -> DotProtoReservedField -> Bool
DotProtoReservedField -> DotProtoReservedField -> Ordering
DotProtoReservedField
-> DotProtoReservedField -> DotProtoReservedField
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DotProtoReservedField
-> DotProtoReservedField -> DotProtoReservedField
$cmin :: DotProtoReservedField
-> DotProtoReservedField -> DotProtoReservedField
max :: DotProtoReservedField
-> DotProtoReservedField -> DotProtoReservedField
$cmax :: DotProtoReservedField
-> DotProtoReservedField -> DotProtoReservedField
>= :: DotProtoReservedField -> DotProtoReservedField -> Bool
$c>= :: DotProtoReservedField -> DotProtoReservedField -> Bool
> :: DotProtoReservedField -> DotProtoReservedField -> Bool
$c> :: DotProtoReservedField -> DotProtoReservedField -> Bool
<= :: DotProtoReservedField -> DotProtoReservedField -> Bool
$c<= :: DotProtoReservedField -> DotProtoReservedField -> Bool
< :: DotProtoReservedField -> DotProtoReservedField -> Bool
$c< :: DotProtoReservedField -> DotProtoReservedField -> Bool
compare :: DotProtoReservedField -> DotProtoReservedField -> Ordering
$ccompare :: DotProtoReservedField -> DotProtoReservedField -> Ordering
$cp1Ord :: Eq DotProtoReservedField
Ord, Int -> DotProtoReservedField -> ShowS
[DotProtoReservedField] -> ShowS
DotProtoReservedField -> String
(Int -> DotProtoReservedField -> ShowS)
-> (DotProtoReservedField -> String)
-> ([DotProtoReservedField] -> ShowS)
-> Show DotProtoReservedField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DotProtoReservedField] -> ShowS
$cshowList :: [DotProtoReservedField] -> ShowS
show :: DotProtoReservedField -> String
$cshow :: DotProtoReservedField -> String
showsPrec :: Int -> DotProtoReservedField -> ShowS
$cshowsPrec :: Int -> DotProtoReservedField -> ShowS
Show)

instance Arbitrary DotProtoReservedField where
  arbitrary :: Gen DotProtoReservedField
arbitrary =
    [Gen DotProtoReservedField] -> Gen DotProtoReservedField
forall a. [Gen a] -> Gen a
oneof [Gen DotProtoReservedField
arbitrarySingleField, Gen DotProtoReservedField
arbitraryFieldRange]
      where
        arbitraryFieldNumber :: Gen Int
arbitraryFieldNumber = do
          Natural
natural <- Gen Natural
forall a. Arbitrary a => Gen a
arbitrary
          Int -> Gen Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural
natural :: Natural))

        arbitrarySingleField :: Gen DotProtoReservedField
arbitrarySingleField = do
          Int
fieldNumber <- Gen Int
arbitraryFieldNumber
          DotProtoReservedField -> Gen DotProtoReservedField
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> DotProtoReservedField
SingleField Int
fieldNumber)

        arbitraryFieldRange :: Gen DotProtoReservedField
arbitraryFieldRange = do
          Int
begin <- Gen Int
arbitraryFieldNumber
          Int
end   <- Gen Int
arbitraryFieldNumber
          DotProtoReservedField -> Gen DotProtoReservedField
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> DotProtoReservedField
FieldRange Int
begin Int
end)

--------------------------------------------------------------------------------
-- | QC Arbitrary instance for generating random protobuf

_arbitraryService :: Gen DotProtoDefinition
_arbitraryService :: Gen DotProtoDefinition
_arbitraryService = do
  String
comment    <- String -> Gen String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
forall a. Monoid a => a
mempty  -- until parser supports comments
  DotProtoIdentifier
identifier <- Gen DotProtoIdentifier
arbitrarySingleIdentifier
  [DotProtoServicePart]
parts      <- Gen DotProtoServicePart -> Gen [DotProtoServicePart]
forall a. Gen a -> Gen [a]
smallListOf Gen DotProtoServicePart
forall a. Arbitrary a => Gen a
arbitrary
  DotProtoDefinition -> Gen DotProtoDefinition
forall (m :: * -> *) a. Monad m => a -> m a
return (String
-> DotProtoIdentifier
-> [DotProtoServicePart]
-> DotProtoDefinition
DotProtoService String
comment DotProtoIdentifier
identifier [DotProtoServicePart]
parts)

arbitraryIdentifierName :: Gen String
arbitraryIdentifierName :: Gen String
arbitraryIdentifierName = do
  Char
c  <- String -> Gen Char
forall a. [a] -> Gen a
elements ([Char
'a'..Char
'z'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'A'..Char
'Z'])
  String
cs <- Gen Char -> Gen String
forall a. Gen a -> Gen [a]
smallListOf (String -> Gen Char
forall a. [a] -> Gen a
elements ([Char
'a'..Char
'z'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'A'..Char
'Z'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'_']))
  String -> Gen String
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
cs)

arbitrarySingleIdentifier :: Gen DotProtoIdentifier
arbitrarySingleIdentifier :: Gen DotProtoIdentifier
arbitrarySingleIdentifier = (String -> DotProtoIdentifier)
-> Gen String -> Gen DotProtoIdentifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> DotProtoIdentifier
Single Gen String
arbitraryIdentifierName

arbitraryPathIdentifier :: Gen DotProtoIdentifier
arbitraryPathIdentifier :: Gen DotProtoIdentifier
arbitraryPathIdentifier = do
  String
name  <- Gen String
arbitraryIdentifierName
  [String]
names <- Gen String -> Gen [String]
forall a. Gen a -> Gen [a]
smallListOf1 Gen String
arbitraryIdentifierName
  DotProtoIdentifier -> Gen DotProtoIdentifier
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DotProtoIdentifier -> Gen DotProtoIdentifier)
-> (NonEmpty String -> DotProtoIdentifier)
-> NonEmpty String
-> Gen DotProtoIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> DotProtoIdentifier
Dots (Path -> DotProtoIdentifier)
-> (NonEmpty String -> Path)
-> NonEmpty String
-> DotProtoIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty String -> Path
Path (NonEmpty String -> Gen DotProtoIdentifier)
-> NonEmpty String -> Gen DotProtoIdentifier
forall a b. (a -> b) -> a -> b
$ String
name String -> [String] -> NonEmpty String
forall a. a -> [a] -> NonEmpty a
NE.:| [String]
names

arbitraryNestedIdentifier :: Gen DotProtoIdentifier
arbitraryNestedIdentifier :: Gen DotProtoIdentifier
arbitraryNestedIdentifier = do
  DotProtoIdentifier
identifier0 <- Gen DotProtoIdentifier
arbitraryIdentifier
  DotProtoIdentifier
identifier1 <- Gen DotProtoIdentifier
arbitrarySingleIdentifier
  DotProtoIdentifier -> Gen DotProtoIdentifier
forall (m :: * -> *) a. Monad m => a -> m a
return (DotProtoIdentifier -> DotProtoIdentifier -> DotProtoIdentifier
Qualified DotProtoIdentifier
identifier0 DotProtoIdentifier
identifier1)

-- these two kinds of identifiers are usually interchangeable, the others are not
arbitraryIdentifier :: Gen DotProtoIdentifier
arbitraryIdentifier :: Gen DotProtoIdentifier
arbitraryIdentifier = [Gen DotProtoIdentifier] -> Gen DotProtoIdentifier
forall a. [Gen a] -> Gen a
oneof [Gen DotProtoIdentifier
arbitrarySingleIdentifier, Gen DotProtoIdentifier
arbitraryPathIdentifier]

-- [note] quickcheck's default scaling generates *extremely* large asts past 20 iterations
--        the parser is not particularly slow but it does have noticeable delay on megabyte-large .proto files
smallListOf :: Gen a -> Gen [a]
smallListOf :: Gen a -> Gen [a]
smallListOf Gen a
x = (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
5) Gen Int -> (Int -> Gen [a]) -> Gen [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
n -> Int -> Gen a -> Gen [a]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n Gen a
x

smallListOf1 :: Gen a -> Gen [a]
smallListOf1 :: Gen a -> Gen [a]
smallListOf1 Gen a
x = (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int
5) Gen Int -> (Int -> Gen [a]) -> Gen [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
n -> Int -> Gen a -> Gen [a]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n Gen a
x