{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, MultiParamTypeClasses #-}
{-# OPTIONS_GHC  -fno-warn-unused-imports #-}
module Text.DescriptorProtos.SourceCodeInfo (SourceCodeInfo(..)) where
import Prelude ((+), (/))
import qualified Prelude 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'
import qualified Text.DescriptorProtos.SourceCodeInfo.Location as DescriptorProtos.SourceCodeInfo (Location)

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

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

instance P'.Mergeable SourceCodeInfo where
  mergeAppend :: SourceCodeInfo -> SourceCodeInfo -> SourceCodeInfo
mergeAppend (SourceCodeInfo Seq Location
x'1 UnknownField
x'2) (SourceCodeInfo Seq Location
y'1 UnknownField
y'2) = Seq Location -> UnknownField -> SourceCodeInfo
SourceCodeInfo (Seq Location -> Seq Location -> Seq Location
forall a. Mergeable a => a -> a -> a
P'.mergeAppend Seq Location
x'1 Seq Location
y'1) (UnknownField -> UnknownField -> UnknownField
forall a. Mergeable a => a -> a -> a
P'.mergeAppend UnknownField
x'2 UnknownField
y'2)

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

instance P'.Wire SourceCodeInfo where
  wireSize :: FieldType -> SourceCodeInfo -> WireSize
wireSize FieldType
ft' self' :: SourceCodeInfo
self'@(SourceCodeInfo Seq Location
x'1 UnknownField
x'2)
   = case FieldType
ft' of
       FieldType
10 -> WireSize
calc'Size
       FieldType
11 -> WireSize -> WireSize
P'.prependMessageSize WireSize
calc'Size
       FieldType
_ -> FieldType -> SourceCodeInfo -> WireSize
forall a. Typeable a => FieldType -> a -> WireSize
P'.wireSizeErr FieldType
ft' SourceCodeInfo
self'
    where
        calc'Size :: WireSize
calc'Size = (WireSize -> FieldType -> Seq Location -> WireSize
forall v. Wire v => WireSize -> FieldType -> Seq v -> WireSize
P'.wireSizeRep WireSize
1 FieldType
11 Seq Location
x'1 WireSize -> WireSize -> WireSize
forall a. Num a => a -> a -> a
+ UnknownField -> WireSize
P'.wireSizeUnknownField UnknownField
x'2)
  wirePutWithSize :: FieldType -> SourceCodeInfo -> PutM WireSize
wirePutWithSize FieldType
ft' self' :: SourceCodeInfo
self'@(SourceCodeInfo Seq Location
x'1 UnknownField
x'2)
   = case FieldType
ft' of
       FieldType
10 -> PutM WireSize
put'Fields
       FieldType
11 -> PutM WireSize
put'FieldsSized
       FieldType
_ -> FieldType -> SourceCodeInfo -> PutM WireSize
forall a b. Typeable a => FieldType -> a -> PutM b
P'.wirePutErr FieldType
ft' SourceCodeInfo
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 Location -> PutM WireSize
forall v. Wire v => WireTag -> FieldType -> Seq v -> PutM WireSize
P'.wirePutRepWithSize WireTag
10 FieldType
11 Seq Location
x'1, UnknownField -> PutM WireSize
P'.wirePutUnknownFieldWithSize UnknownField
x'2]
        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 SourceCodeInfo
wireGet FieldType
ft'
   = case FieldType
ft' of
       FieldType
10 -> (WireTag -> SourceCodeInfo -> Get SourceCodeInfo)
-> Get SourceCodeInfo
forall message.
(Default message, ReflectDescriptor message) =>
(WireTag -> message -> Get message) -> Get message
P'.getBareMessageWith ((WireTag -> SourceCodeInfo -> Get SourceCodeInfo)
-> WireTag -> SourceCodeInfo -> Get SourceCodeInfo
forall a.
UnknownMessage a =>
(WireTag -> a -> Get a) -> WireTag -> a -> Get a
P'.catch'Unknown WireTag -> SourceCodeInfo -> Get SourceCodeInfo
update'Self)
       FieldType
11 -> (WireTag -> SourceCodeInfo -> Get SourceCodeInfo)
-> Get SourceCodeInfo
forall message.
(Default message, ReflectDescriptor message) =>
(WireTag -> message -> Get message) -> Get message
P'.getMessageWith ((WireTag -> SourceCodeInfo -> Get SourceCodeInfo)
-> WireTag -> SourceCodeInfo -> Get SourceCodeInfo
forall a.
UnknownMessage a =>
(WireTag -> a -> Get a) -> WireTag -> a -> Get a
P'.catch'Unknown WireTag -> SourceCodeInfo -> Get SourceCodeInfo
update'Self)
       FieldType
_ -> FieldType -> Get SourceCodeInfo
forall a. Typeable a => FieldType -> Get a
P'.wireGetErr FieldType
ft'
    where
        update'Self :: WireTag -> SourceCodeInfo -> Get SourceCodeInfo
update'Self WireTag
wire'Tag SourceCodeInfo
old'Self
         = case WireTag
wire'Tag of
             WireTag
10 -> (Location -> SourceCodeInfo) -> Get Location -> Get SourceCodeInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude'.fmap (\ !Location
new'Field -> SourceCodeInfo
old'Self{location :: Seq Location
location = Seq Location -> Location -> Seq Location
forall a. Seq a -> a -> Seq a
P'.append (SourceCodeInfo -> Seq Location
location SourceCodeInfo
old'Self) Location
new'Field}) (FieldType -> Get Location
forall b. Wire b => FieldType -> Get b
P'.wireGet FieldType
11)
             WireTag
_ -> let (FieldId
field'Number, WireType
wire'Type) = WireTag -> (FieldId, WireType)
P'.splitWireTag WireTag
wire'Tag in FieldId -> WireType -> SourceCodeInfo -> Get SourceCodeInfo
forall a.
(Typeable a, ReflectDescriptor a) =>
FieldId -> WireType -> a -> Get a
P'.unknown FieldId
field'Number WireType
wire'Type SourceCodeInfo
old'Self

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

instance P'.GPB SourceCodeInfo

instance P'.ReflectDescriptor SourceCodeInfo where
  getMessageInfo :: SourceCodeInfo -> GetMessageInfo
getMessageInfo SourceCodeInfo
_ = 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
10])
  reflectDescriptorInfo :: SourceCodeInfo -> DescriptorInfo
reflectDescriptorInfo SourceCodeInfo
_
   = String -> DescriptorInfo
forall a. Read a => String -> a
Prelude'.read
      String
"DescriptorInfo {descName = ProtoName {protobufName = FIName \".google.protobuf.SourceCodeInfo\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\"], baseName = MName \"SourceCodeInfo\"}, descFilePath = [\"Text\",\"DescriptorProtos\",\"SourceCodeInfo.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".google.protobuf.SourceCodeInfo.location\", haskellPrefix' = [MName \"Text\"], parentModule' = [MName \"DescriptorProtos\",MName \"SourceCodeInfo\"], baseName' = FName \"location\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".google.protobuf.SourceCodeInfo.Location\", haskellPrefix = [MName \"Text\"], parentModule = [MName \"DescriptorProtos\",MName \"SourceCodeInfo\"], baseName = MName \"Location\"}), hsRawDefault = Nothing, hsDefault = Nothing}], descOneofs = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = True, lazyFields = False, makeLenses = False}"

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

instance P'.TextMsg SourceCodeInfo where
  textPut :: SourceCodeInfo -> Output
textPut SourceCodeInfo
msg
   = do
       String -> Seq Location -> Output
forall a. TextType a => String -> a -> Output
P'.tellT String
"location" (SourceCodeInfo -> Seq Location
location SourceCodeInfo
msg)
  textGet :: Parsec s () SourceCodeInfo
textGet
   = do
       [SourceCodeInfo -> SourceCodeInfo]
mods <- ParsecT s () Identity (SourceCodeInfo -> SourceCodeInfo)
-> ParsecT s () Identity ()
-> ParsecT s () Identity [SourceCodeInfo -> SourceCodeInfo]
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 (SourceCodeInfo -> SourceCodeInfo)]
-> ParsecT s () Identity (SourceCodeInfo -> SourceCodeInfo)
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 (SourceCodeInfo -> SourceCodeInfo)
parse'location]) ParsecT s () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P'.spaces
       SourceCodeInfo -> Parsec s () SourceCodeInfo
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return ((SourceCodeInfo
 -> (SourceCodeInfo -> SourceCodeInfo) -> SourceCodeInfo)
-> SourceCodeInfo
-> [SourceCodeInfo -> SourceCodeInfo]
-> SourceCodeInfo
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Prelude'.foldl (\ SourceCodeInfo
v SourceCodeInfo -> SourceCodeInfo
f -> SourceCodeInfo -> SourceCodeInfo
f SourceCodeInfo
v) SourceCodeInfo
forall a. Default a => a
P'.defaultValue [SourceCodeInfo -> SourceCodeInfo]
mods)
    where
        parse'location :: ParsecT s () Identity (SourceCodeInfo -> SourceCodeInfo)
parse'location
         = ParsecT s () Identity (SourceCodeInfo -> SourceCodeInfo)
-> ParsecT s () Identity (SourceCodeInfo -> SourceCodeInfo)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P'.try
            (do
               Location
v <- String -> Parsec s () Location
forall a s.
(TextType a, Stream s Identity Char) =>
String -> Parsec s () a
P'.getT String
"location"
               (SourceCodeInfo -> SourceCodeInfo)
-> ParsecT s () Identity (SourceCodeInfo -> SourceCodeInfo)
forall (m :: * -> *) a. Monad m => a -> m a
Prelude'.return (\ SourceCodeInfo
o -> SourceCodeInfo
o{location :: Seq Location
location = Seq Location -> Location -> Seq Location
forall a. Seq a -> a -> Seq a
P'.append (SourceCodeInfo -> Seq Location
location SourceCodeInfo
o) Location
v}))