{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings #-}
{-# OPTIONS_GHC  -w #-}
module Text.DescriptorProtos.SourceCodeInfo.Location (Location(..)) where
import Prelude ((+), (/), (++), (.))
import qualified Prelude as Prelude'
import qualified Data.List as Prelude'
import qualified Data.Typeable as Prelude'
import qualified GHC.Generics as Prelude'
import qualified Data.Data as Prelude'
import qualified Text.ProtocolBuffers.Header as P'

data Location = Location{Location -> Seq Int32
path :: !(P'.Seq P'.Int32), Location -> Seq Int32
span :: !(P'.Seq P'.Int32), Location -> Maybe Utf8
leading_comments :: !(P'.Maybe P'.Utf8),
                         Location -> Maybe Utf8
trailing_comments :: !(P'.Maybe P'.Utf8), Location -> Seq Utf8
leading_detached_comments :: !(P'.Seq P'.Utf8),
                         Location -> UnknownField
unknown'field :: !(P'.UnknownField)}
                deriving (Int -> Location -> ShowS
[Location] -> ShowS
Location -> String
(Int -> Location -> ShowS)
-> (Location -> String) -> ([Location] -> ShowS) -> Show Location
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Location] -> ShowS
$cshowList :: [Location] -> ShowS
show :: Location -> String
$cshow :: Location -> String
showsPrec :: Int -> Location -> ShowS
$cshowsPrec :: Int -> Location -> ShowS
Prelude'.Show, Location -> Location -> Bool
(Location -> Location -> Bool)
-> (Location -> Location -> Bool) -> Eq Location
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Location -> Location -> Bool
$c/= :: Location -> Location -> Bool
== :: Location -> Location -> Bool
$c== :: Location -> Location -> Bool
Prelude'.Eq, Eq Location
Eq Location
-> (Location -> Location -> Ordering)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Location)
-> (Location -> Location -> Location)
-> Ord Location
Location -> Location -> Bool
Location -> Location -> Ordering
Location -> Location -> Location
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 :: Location -> Location -> Location
$cmin :: Location -> Location -> Location
max :: Location -> Location -> Location
$cmax :: Location -> Location -> Location
>= :: Location -> Location -> Bool
$c>= :: Location -> Location -> Bool
> :: Location -> Location -> Bool
$c> :: Location -> Location -> Bool
<= :: Location -> Location -> Bool
$c<= :: Location -> Location -> Bool
< :: Location -> Location -> Bool
$c< :: Location -> Location -> Bool
compare :: Location -> Location -> Ordering
$ccompare :: Location -> Location -> Ordering
$cp1Ord :: Eq Location
Prelude'.Ord, Prelude'.Typeable, Typeable Location
DataType
Constr
Typeable Location
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Location -> c Location)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Location)
-> (Location -> Constr)
-> (Location -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Location))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Location))
-> ((forall b. Data b => b -> b) -> Location -> Location)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Location -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Location -> r)
-> (forall u. (forall d. Data d => d -> u) -> Location -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Location -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Location -> m Location)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Location -> m Location)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Location -> m Location)
-> Data Location
Location -> DataType
Location -> Constr
(forall b. Data b => b -> b) -> Location -> Location
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Location -> c Location
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Location
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) -> Location -> u
forall u. (forall d. Data d => d -> u) -> Location -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Location -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Location -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Location -> m Location
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Location -> m Location
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Location
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Location -> c Location
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Location)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Location)
$cLocation :: Constr
$tLocation :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Location -> m Location
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Location -> m Location
gmapMp :: (forall d. Data d => d -> m d) -> Location -> m Location
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Location -> m Location
gmapM :: (forall d. Data d => d -> m d) -> Location -> m Location
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Location -> m Location
gmapQi :: Int -> (forall d. Data d => d -> u) -> Location -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Location -> u
gmapQ :: (forall d. Data d => d -> u) -> Location -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Location -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Location -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Location -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Location -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Location -> r
gmapT :: (forall b. Data b => b -> b) -> Location -> Location
$cgmapT :: (forall b. Data b => b -> b) -> Location -> Location
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Location)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Location)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Location)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Location)
dataTypeOf :: Location -> DataType
$cdataTypeOf :: Location -> DataType
toConstr :: Location -> Constr
$ctoConstr :: Location -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Location
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Location
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Location -> c Location
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Location -> c Location
$cp1Data :: Typeable Location
Prelude'.Data, (forall x. Location -> Rep Location x)
-> (forall x. Rep Location x -> Location) -> Generic Location
forall x. Rep Location x -> Location
forall x. Location -> Rep Location x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Location x -> Location
$cfrom :: forall x. Location -> Rep Location x
Prelude'.Generic)

instance P'.UnknownMessage Location where
  getUnknownField :: Location -> UnknownField
getUnknownField = Location -> UnknownField
unknown'field
  putUnknownField :: UnknownField -> Location -> Location
putUnknownField UnknownField
u'f Location
msg = Location
msg{unknown'field :: UnknownField
unknown'field = UnknownField
u'f}

instance P'.Mergeable Location where
  mergeAppend :: Location -> Location -> Location
mergeAppend (Location Seq Int32
x'1 Seq Int32
x'2 Maybe Utf8
x'3 Maybe Utf8
x'4 Seq Utf8
x'5 UnknownField
x'6) (Location Seq Int32
y'1 Seq Int32
y'2 Maybe Utf8
y'3 Maybe Utf8
y'4 Seq Utf8
y'5 UnknownField
y'6)
   = let !z'1 :: Seq Int32
z'1 = Seq Int32 -> Seq Int32 -> Seq Int32
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Seq Int32
x'1 Seq Int32
y'1
         !z'2 :: Seq Int32
z'2 = Seq Int32 -> Seq Int32 -> Seq Int32
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Seq Int32
x'2 Seq Int32
y'2
         !z'3 :: Maybe Utf8
z'3 = Maybe Utf8 -> Maybe Utf8 -> Maybe Utf8
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Utf8
x'3 Maybe Utf8
y'3
         !z'4 :: Maybe Utf8
z'4 = Maybe Utf8 -> Maybe Utf8 -> Maybe Utf8
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Maybe Utf8
x'4 Maybe Utf8
y'4
         !z'5 :: Seq Utf8
z'5 = Seq Utf8 -> Seq Utf8 -> Seq Utf8
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Seq Utf8
x'5 Seq Utf8
y'5
         !z'6 :: UnknownField
z'6 = UnknownField -> UnknownField -> UnknownField
forall a. Mergeable a => a -> a -> a
P'.mergeAppend UnknownField
x'6 UnknownField
y'6
      in Seq Int32
-> Seq Int32
-> Maybe Utf8
-> Maybe Utf8
-> Seq Utf8
-> UnknownField
-> Location
Location Seq Int32
z'1 Seq Int32
z'2 Maybe Utf8
z'3 Maybe Utf8
z'4 Seq Utf8
z'5 UnknownField
z'6

instance P'.Default Location where
  defaultValue :: Location
defaultValue = Seq Int32
-> Seq Int32
-> Maybe Utf8
-> Maybe Utf8
-> Seq Utf8
-> UnknownField
-> Location
Location Seq Int32
forall a. Default a => a
P'.defaultValue Seq Int32
forall a. Default a => a
P'.defaultValue Maybe Utf8
forall a. Default a => a
P'.defaultValue Maybe Utf8
forall a. Default a => a
P'.defaultValue Seq Utf8
forall a. Default a => a
P'.defaultValue UnknownField
forall a. Default a => a
P'.defaultValue

instance P'.Wire Location where
  wireSize :: FieldType -> Location -> WireSize
wireSize FieldType
ft' self' :: Location
self'@(Location Seq Int32
x'1 Seq Int32
x'2 Maybe Utf8
x'3 Maybe Utf8
x'4 Seq Utf8
x'5 UnknownField
x'6)
   = case FieldType
ft' of
       FieldType
10 -> WireSize
calc'Size
       FieldType
11 -> WireSize -> WireSize
P'.prependMessageSize WireSize
calc'Size
       FieldType
_ -> FieldType -> Location -> WireSize
forall a. Typeable a => FieldType -> a -> WireSize
P'.wireSizeErr FieldType
ft' Location
self'
    where
        calc'Size :: WireSize
calc'Size
         = (WireSize -> FieldType -> Seq Int32 -> WireSize
forall v. Wire v => WireSize -> FieldType -> Seq v -> WireSize
P'.wireSizePacked WireSize
1 FieldType
5 Seq Int32
x'1 WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ WireSize -> FieldType -> Seq Int32 -> WireSize
forall v. Wire v => WireSize -> FieldType -> Seq v -> WireSize
P'.wireSizePacked WireSize
1 FieldType
5 Seq Int32
x'2 WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ WireSize -> FieldType -> Maybe Utf8 -> WireSize
forall v. Wire v => WireSize -> FieldType -> Maybe v -> WireSize
P'.wireSizeOpt WireSize
1 FieldType
9 Maybe Utf8
x'3 WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ WireSize -> FieldType -> Maybe Utf8 -> WireSize
forall v. Wire v => WireSize -> FieldType -> Maybe v -> WireSize
P'.wireSizeOpt WireSize
1 FieldType
9 Maybe Utf8
x'4 WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+
             WireSize -> FieldType -> Seq Utf8 -> WireSize
forall v. Wire v => WireSize -> FieldType -> Seq v -> WireSize
P'.wireSizeRep WireSize
1 FieldType
9 Seq Utf8
x'5
             WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ UnknownField -> WireSize
P'.wireSizeUnknownField UnknownField
x'6)
  wirePutWithSize :: FieldType -> Location -> PutM WireSize
wirePutWithSize FieldType
ft' self' :: Location
self'@(Location Seq Int32
x'1 Seq Int32
x'2 Maybe Utf8
x'3 Maybe Utf8
x'4 Seq Utf8
x'5 UnknownField
x'6)
   = case FieldType
ft' of
       FieldType
10 -> PutM WireSize
put'Fields
       FieldType
11 -> PutM WireSize
put'FieldsSized
       FieldType
_ -> FieldType -> Location -> PutM WireSize
forall a b. Typeable a => FieldType -> a -> PutM b
P'.wirePutErr FieldType
ft' Location
self'
    where
        put'Fields :: PutM WireSize
put'Fields
         = [PutM WireSize] -> PutM WireSize
forall (f :: * -> *).
Foldable f =>
f (PutM WireSize) -> PutM WireSize
P'.sequencePutWithSize
            [WireTag -> FieldType -> Seq Int32 -> PutM WireSize
forall v. Wire v => WireTag -> FieldType -> Seq v -> PutM WireSize
P'.wirePutPackedWithSize WireTag
10 FieldType
5 Seq Int32
x'1, WireTag -> FieldType -> Seq Int32 -> PutM WireSize
forall v. Wire v => WireTag -> FieldType -> Seq v -> PutM WireSize
P'.wirePutPackedWithSize WireTag
18 FieldType
5 Seq Int32
x'2, WireTag -> FieldType -> Maybe Utf8 -> PutM WireSize
forall v.
Wire v =>
WireTag -> FieldType -> Maybe v -> PutM WireSize
P'.wirePutOptWithSize WireTag
26 FieldType
9 Maybe Utf8
x'3,
             WireTag -> FieldType -> Maybe Utf8 -> PutM WireSize
forall v.
Wire v =>
WireTag -> FieldType -> Maybe v -> PutM WireSize
P'.wirePutOptWithSize WireTag
34 FieldType
9 Maybe Utf8
x'4, WireTag -> FieldType -> Seq Utf8 -> PutM WireSize
forall v. Wire v => WireTag -> FieldType -> Seq v -> PutM WireSize
P'.wirePutRepWithSize WireTag
50 FieldType
9 Seq Utf8
x'5, UnknownField -> PutM WireSize
P'.wirePutUnknownFieldWithSize UnknownField
x'6]
        put'FieldsSized :: PutM WireSize
put'FieldsSized
         = let size' :: WireSize
size' = (WireSize, ByteString) -> WireSize
forall a b. (a, b) -> a
Prelude'.fst (PutM WireSize -> (WireSize, ByteString)
forall a. PutM a -> (a, ByteString)
P'.runPutM PutM WireSize
put'Fields)
               put'Size :: PutM WireSize
put'Size
                = do
                    WireSize -> Put
P'.putSize WireSize
size'
                    WireSize -> PutM WireSize
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (WireSize -> WireSize
P'.size'WireSize WireSize
size')
            in [PutM WireSize] -> PutM WireSize
forall (f :: * -> *).
Foldable f =>
f (PutM WireSize) -> PutM WireSize
P'.sequencePutWithSize [PutM WireSize
put'Size, PutM WireSize
put'Fields]
  wireGet :: FieldType -> Get Location
wireGet FieldType
ft'
   = case FieldType
ft' of
       FieldType
10 -> (WireTag -> Location -> Get Location) -> Get Location
forall message.
(Default message, ReflectDescriptor message) =>
(WireTag -> message -> Get message) -> Get message
P'.getBareMessageWith ((WireTag -> Location -> Get Location)
-> (WireTag -> Location -> Get Location)
-> WireTag
-> Location
-> Get Location
forall a.
(WireTag -> a -> Get a)
-> (WireTag -> a -> Get a) -> WireTag -> a -> Get a
P'.catch'Unknown' WireTag -> Location -> Get Location
forall a. UnknownMessage a => WireTag -> a -> Get a
P'.loadUnknown WireTag -> Location -> Get Location
update'Self)
       FieldType
11 -> (WireTag -> Location -> Get Location) -> Get Location
forall message.
(Default message, ReflectDescriptor message) =>
(WireTag -> message -> Get message) -> Get message
P'.getMessageWith ((WireTag -> Location -> Get Location)
-> (WireTag -> Location -> Get Location)
-> WireTag
-> Location
-> Get Location
forall a.
(WireTag -> a -> Get a)
-> (WireTag -> a -> Get a) -> WireTag -> a -> Get a
P'.catch'Unknown' WireTag -> Location -> Get Location
forall a. UnknownMessage a => WireTag -> a -> Get a
P'.loadUnknown WireTag -> Location -> Get Location
update'Self)
       FieldType
_ -> FieldType -> Get Location
forall a. Typeable a => FieldType -> Get a
P'.wireGetErr FieldType
ft'
    where
        update'Self :: WireTag -> Location -> Get Location
update'Self WireTag
wire'Tag Location
old'Self
         = case WireTag
wire'Tag of
             WireTag
8 -> (Int32 -> Location) -> Get Int32 -> Get Location
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Int32
new'Field -> Location
old'Self{path :: Seq Int32
path = Seq Int32 -> Int32 -> Seq Int32
forall a. Seq a -> a -> Seq a
P'.append (Location -> Seq Int32
path Location
old'Self) Int32
new'Field}) (FieldType -> Get Int32
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
5)
             WireTag
10 -> (Seq Int32 -> Location) -> Get (Seq Int32) -> Get Location
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Seq Int32
new'Field -> Location
old'Self{path :: Seq Int32
path = Seq Int32 -> Seq Int32 -> Seq Int32
forall a. Mergeable a => a -> a -> a
P'.mergeAppend (Location -> Seq Int32
path Location
old'Self) Seq Int32
new'Field}) (FieldType -> Get (Seq Int32)
forall b. Wire b => FieldType -> Get (Seq b)
P'.wireGetPacked FieldType
5)
             WireTag
16 -> (Int32 -> Location) -> Get Int32 -> Get Location
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Int32
new'Field -> Location
old'Self{span :: Seq Int32
span = Seq Int32 -> Int32 -> Seq Int32
forall a. Seq a -> a -> Seq a
P'.append (Location -> Seq Int32
span Location
old'Self) Int32
new'Field}) (FieldType -> Get Int32
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
5)
             WireTag
18 -> (Seq Int32 -> Location) -> Get (Seq Int32) -> Get Location
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Seq Int32
new'Field -> Location
old'Self{span :: Seq Int32
span = Seq Int32 -> Seq Int32 -> Seq Int32
forall a. Mergeable a => a -> a -> a
P'.mergeAppend (Location -> Seq Int32
span Location
old'Self) Seq Int32
new'Field}) (FieldType -> Get (Seq Int32)
forall b. Wire b => FieldType -> Get (Seq b)
P'.wireGetPacked FieldType
5)
             WireTag
26 -> (Utf8 -> Location) -> Get Utf8 -> Get Location
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Utf8
new'Field -> Location
old'Self{leading_comments :: Maybe Utf8
leading_comments = Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Prelude'.Just Utf8
new'Field}) (FieldType -> Get Utf8
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
9)
             WireTag
34 -> (Utf8 -> Location) -> Get Utf8 -> Get Location
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Utf8
new'Field -> Location
old'Self{trailing_comments :: Maybe Utf8
trailing_comments = Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Prelude'.Just Utf8
new'Field}) (FieldType -> Get Utf8
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
9)
             WireTag
50 -> (Utf8 -> Location) -> Get Utf8 -> Get Location
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap
                    (\ !Utf8
new'Field -> Location
old'Self{leading_detached_comments :: Seq Utf8
leading_detached_comments = Seq Utf8 -> Utf8 -> Seq Utf8
forall a. Seq a -> a -> Seq a
P'.append (Location -> Seq Utf8
leading_detached_comments Location
old'Self) Utf8
new'Field})
                    (FieldType -> Get Utf8
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
9)
             WireTag
_ -> let (FieldId
field'Number, WireType
wire'Type) = WireTag -> (FieldId, WireType)
P'.splitWireTag WireTag
wire'Tag in FieldId -> WireType -> Location -> Get Location
forall a.
(Typeable a, ReflectDescriptor a) =>
FieldId -> WireType -> a -> Get a
P'.unknown FieldId
field'Number WireType
wire'Type Location
old'Self

instance P'.MessageAPI msg' (msg' -> Location) Location where
  getVal :: msg' -> (msg' -> Location) -> Location
getVal msg'
m' msg' -> Location
f' = msg' -> Location
f' msg'
m'

instance P'.GPB Location

instance P'.ReflectDescriptor Location where
  getMessageInfo :: Location -> GetMessageInfo
getMessageInfo Location
_ = Set WireTag -> Set WireTag -> GetMessageInfo
P'.GetMessageInfo ([WireTag] -> Set WireTag
forall a. [a] -> Set a
P'.fromDistinctAscList []) ([WireTag] -> Set WireTag
forall a. [a] -> Set a
P'.fromDistinctAscList [WireTag
8, WireTag
10, WireTag
16, WireTag
18, WireTag
26, WireTag
34, WireTag
50])
  reflectDescriptorInfo :: Location -> DescriptorInfo
reflectDescriptorInfo Location
_
   = String -> DescriptorInfo
forall a. Read a => String -> a
Prelude'.read
      String
"DescriptorInfo {descName = ProtoName {protobufName = FIName \".google.protobuf.SourceCodeInfo.Location\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\",MName \"SourceCodeInfo\"], baseName = MName \"Location\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"SourceCodeInfo\",\"Location.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.SourceCodeInfo.Location.path\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"SourceCodeInfo\",MName \"Location\"], baseName' = FName \"path\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Just (WireTag {getWireTag = 8},WireTag {getWireTag = 10}), wireTagLength = 1, isPacked = True, isRequired = False, canRepeat = True, mightPack = True, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.SourceCodeInfo.Location.span\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"SourceCodeInfo\",MName \"Location\"], baseName' = FName \"span\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Just (WireTag {getWireTag = 16},WireTag {getWireTag = 18}), wireTagLength = 1, isPacked = True, isRequired = False, canRepeat = True, mightPack = True, typeCode = FieldType {getFieldType = 5}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.SourceCodeInfo.Location.leading_comments\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"SourceCodeInfo\",MName \"Location\"], baseName' = FName \"leading_comments\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.SourceCodeInfo.Location.trailing_comments\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"SourceCodeInfo\",MName \"Location\"], baseName' = FName \"trailing_comments\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 34}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.SourceCodeInfo.Location.leading_detached_comments\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"SourceCodeInfo\",MName \"Location\"], baseName' = FName \"leading_detached_comments\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 6}, wireTag = WireTag {getWireTag = 50}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], descOneofs = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = True, lazyFields = False, makeLenses = False, jsonInstances = False}"

instance P'.TextType Location where
  tellT :: String -> Location -> Output
tellT = String -> Location -> Output
forall a. TextMsg a => String -> a -> Output
P'.tellSubMessage
  getT :: String -> Parsec s () Location
getT = String -> Parsec s () Location
forall s a.
(Stream s Identity Char, TextMsg a) =>
String -> Parsec s () a
P'.getSubMessage

instance P'.TextMsg Location where
  textPut :: Location -> Output
textPut Location
msg
   = do
       String -> Seq Int32 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"path" (Location -> Seq Int32
path Location
msg)
       String -> Seq Int32 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"span" (Location -> Seq Int32
span Location
msg)
       String -> Maybe Utf8 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"leading_comments" (Location -> Maybe Utf8
leading_comments Location
msg)
       String -> Maybe Utf8 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"trailing_comments" (Location -> Maybe Utf8
trailing_comments Location
msg)
       String -> Seq Utf8 -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"leading_detached_comments" (Location -> Seq Utf8
leading_detached_comments Location
msg)
  textGet :: Parsec s () Location
textGet
   = do
       [Location -> Location]
mods <- ParsecT s () Identity (Location -> Location)
-> ParsecT s () Identity ()
-> ParsecT s () Identity [Location -> Location]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
P'.sepEndBy
                ([ParsecT s () Identity (Location -> Location)]
-> ParsecT s () Identity (Location -> Location)
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
P'.choice
                  [ParsecT s () Identity (Location -> Location)
parse'path, ParsecT s () Identity (Location -> Location)
parse'span, ParsecT s () Identity (Location -> Location)
parse'leading_comments, ParsecT s () Identity (Location -> Location)
parse'trailing_comments, ParsecT s () Identity (Location -> Location)
parse'leading_detached_comments])
                ParsecT s () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P'.spaces
       Location -> Parsec s () Location
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return ((Location -> (Location -> Location) -> Location)
-> Location -> [Location -> Location] -> Location
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Prelude'.foldl' (\ Location
v Location -> Location
f -> Location -> Location
f Location
v) Location
forall a. Default a => a
P'.defaultValue [Location -> Location]
mods)
    where
        parse'path :: ParsecT s () Identity (Location -> Location)
parse'path = (Int32 -> Location -> Location)
-> ParsecT s () Identity Int32
-> ParsecT s () Identity (Location -> Location)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ Int32
v Location
o -> Location
o{path :: Seq Int32
path = Seq Int32 -> Int32 -> Seq Int32
forall a. Seq a -> a -> Seq a
P'.append (Location -> Seq Int32
path Location
o) Int32
v}) (ParsecT s () Identity Int32 -> ParsecT s () Identity Int32
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try (String -> ParsecT s () Identity Int32
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"path"))
        parse'span :: ParsecT s () Identity (Location -> Location)
parse'span = (Int32 -> Location -> Location)
-> ParsecT s () Identity Int32
-> ParsecT s () Identity (Location -> Location)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ Int32
v Location
o -> Location
o{span :: Seq Int32
span = Seq Int32 -> Int32 -> Seq Int32
forall a. Seq a -> a -> Seq a
P'.append (Location -> Seq Int32
span Location
o) Int32
v}) (ParsecT s () Identity Int32 -> ParsecT s () Identity Int32
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try (String -> ParsecT s () Identity Int32
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"span"))
        parse'leading_comments :: ParsecT s () Identity (Location -> Location)
parse'leading_comments = (Maybe Utf8 -> Location -> Location)
-> ParsecT s () Identity (Maybe Utf8)
-> ParsecT s () Identity (Location -> Location)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ Maybe Utf8
v Location
o -> Location
o{leading_comments :: Maybe Utf8
leading_comments = Maybe Utf8
v}) (ParsecT s () Identity (Maybe Utf8)
-> ParsecT s () Identity (Maybe Utf8)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try (String -> ParsecT s () Identity (Maybe Utf8)
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"leading_comments"))
        parse'trailing_comments :: ParsecT s () Identity (Location -> Location)
parse'trailing_comments = (Maybe Utf8 -> Location -> Location)
-> ParsecT s () Identity (Maybe Utf8)
-> ParsecT s () Identity (Location -> Location)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ Maybe Utf8
v Location
o -> Location
o{trailing_comments :: Maybe Utf8
trailing_comments = Maybe Utf8
v}) (ParsecT s () Identity (Maybe Utf8)
-> ParsecT s () Identity (Maybe Utf8)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try (String -> ParsecT s () Identity (Maybe Utf8)
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"trailing_comments"))
        parse'leading_detached_comments :: ParsecT s () Identity (Location -> Location)
parse'leading_detached_comments
         = (Utf8 -> Location -> Location)
-> ParsecT s () Identity Utf8
-> ParsecT s () Identity (Location -> Location)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ Utf8
v Location
o -> Location
o{leading_detached_comments :: Seq Utf8
leading_detached_comments = Seq Utf8 -> Utf8 -> Seq Utf8
forall a. Seq a -> a -> Seq a
P'.append (Location -> Seq Utf8
leading_detached_comments Location
o) Utf8
v})
            (ParsecT s () Identity Utf8 -> ParsecT s () Identity Utf8
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try (String -> ParsecT s () Identity Utf8
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"leading_detached_comments"))