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

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# 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.Int                  (Int32)
import qualified Data.List.NonEmpty        as NE
import           Data.String               (IsString)
import qualified Filesystem.Path.CurrentOS as FP
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 (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, 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, String -> MessageName
(String -> MessageName) -> IsString MessageName
forall a. (String -> a) -> IsString a
fromString :: String -> MessageName
$cfromString :: String -> MessageName
IsString)

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 (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, 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, String -> FieldName
(String -> FieldName) -> IsString FieldName
forall a. (String -> a) -> IsString a
fromString :: String -> FieldName
$cfromString :: String -> FieldName
IsString)

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 (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, 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, String -> PackageName
(String -> PackageName) -> IsString PackageName
forall a. (String -> a) -> IsString a
fromString :: String -> PackageName
$cfromString :: String -> PackageName
IsString)

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 (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, 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, 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)

-- 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 (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, 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, 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)

-- | Top-level import declaration
data DotProtoImport = DotProtoImport
  { DotProtoImport -> DotProtoImportQualifier
dotProtoImportQualifier :: DotProtoImportQualifier
  , DotProtoImport -> FilePath
dotProtoImportPath      :: FilePath
  } deriving (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, 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, 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)

instance Arbitrary DotProtoImport where
    arbitrary :: Gen DotProtoImport
arbitrary = do
      DotProtoImportQualifier
dotProtoImportQualifier <- Gen DotProtoImportQualifier
forall a. Arbitrary a => Gen a
arbitrary
      let dotProtoImportPath :: FilePath
dotProtoImportPath = FilePath
FP.empty
      DotProtoImport -> Gen DotProtoImport
forall (m :: * -> *) a. Monad m => a -> m a
return (DotProtoImport :: DotProtoImportQualifier -> FilePath -> DotProtoImport
DotProtoImport {FilePath
DotProtoImportQualifier
dotProtoImportPath :: FilePath
dotProtoImportQualifier :: DotProtoImportQualifier
dotProtoImportPath :: FilePath
dotProtoImportQualifier :: DotProtoImportQualifier
..})

data DotProtoImportQualifier
  = DotProtoImportPublic
  | DotProtoImportWeak
  | DotProtoImportDefault
  deriving (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, 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, 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)

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 (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, 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)

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 (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, 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, 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)

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 (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, 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)


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 (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, 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)

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 (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, 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)

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 (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, 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, 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)

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 (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, 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)

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 (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, 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)

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
  | Optional       DotProtoPrimType
  | Repeated       DotProtoPrimType
  | NestedRepeated DotProtoPrimType
  | Map            DotProtoPrimType DotProtoPrimType
  deriving (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, 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)

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 (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, 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)

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 (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, 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)

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 (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, 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)

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 (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, 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)

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]
  deriving (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, 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)

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
<$> String -> Gen String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"")

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 (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, 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)

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 (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, 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)

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