Use a custom parsing monad instead of attoparsec.

proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate/Encoding.hs

@@ -237,7 +237,6 @@ parseFieldCase loop x f = case plainFieldKind f of
     _ -> [valueCase]
   where
     y = "y"
-    bytes = "bytes"
     entry = "entry"
     info = plainFieldInfo f
     valueCase = pLitInt (fieldTag info) --> do'
@@ -258,11 +257,7 @@ parseFieldCase loop x f = case plainFieldKind f of
             $ x
         ]
     packedCase = pLitInt (packedFieldTag info) --> do'
-        [ bytes <-- parseFieldType lengthy
-        , y <-- "Data.ProtoLens.Encoding.Bytes.runEither"
-                    @@ ("Data.ProtoLens.Encoding.Bytes.runParser"
-                        @@ parsePackedField info
-                        @@ bytes)
+        [ y <-- isolatedLengthy (parsePackedField info)
         , stmt . loop . updateParseState (overField info ("Prelude.++" @@ y))
             $ x
         ]

proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate/FieldEncoding.hs

@@ -11,6 +11,7 @@ module Data.ProtoLens.Compiler.Generate.FieldEncoding
     , fieldEncoding
     , lengthy
     , groupEnd
+    , isolatedLengthy
     ) where
 
 import Data.Word (Word8)
@@ -181,10 +182,24 @@ stringField = partialField "Data.Text.Encoding.encodeUtf8" decodeUtf8P lengthy
 
 -- | A protobuf message type.
 message :: FieldEncoding
-message = partialField
+message = lengthy
+        { buildFieldType = "Prelude.." @@
+            buildFieldType lengthy @@
             "Data.ProtoLens.encodeMessage"
-            (\m -> "Data.ProtoLens.decodeMessage" @@ m)
-            lengthy
+        , parseFieldType = isolatedLengthy "Data.ProtoLens.parseMessage"
+        }
+
+-- | Takes a @Parser a@, reads a varint and then runs the parser
+-- isolated to the given length.
+isolatedLengthy :: Exp -> Exp
+isolatedLengthy parser = do'
+    [ len <-- getVarInt'
+    , stmt $ "Data.ProtoLens.Encoding.Bytes.isolate"
+                @@ (fromIntegral' @@ len)
+                @@ parser
+    ]
+  where
+    len = "len"
 
 -- | Some functions that are used in multiple places in the generated code.
 getVarInt', putVarInt', fromIntegral' :: Exp

proto-lens/src/Data/ProtoLens/Encoding/Bytes.hs

@@ -15,6 +15,7 @@ module Data.ProtoLens.Encoding.Bytes(
     Parser,
     Builder,
     runParser,
+    isolate,
     runBuilder,
     -- * Bytestrings
     getBytes,

proto-lens/src/Data/ProtoLens/Encoding/Parser.hs

@@ -6,6 +6,7 @@ module Data.ProtoLens.Encoding.Parser
     ( Parser
     , runParser
     , atEnd
+    , isolate
     , getWord8
     , getWord32le
     , getBytes
@@ -104,6 +105,17 @@ withSized len message f = Parser $ \end pos ->
         else liftIO $ ParserResult pos' <$> f pos
 {-# INLINE withSized #-}
 
+-- | Run the given parsing action as if there are only 
+-- @len@ bytes remaining.  That is, once @len@ bytes have been
+-- consumed, 'atEnd' will return 'True' and other actions
+-- like 'getWord8' will act like there is no input remaining.
+isolate :: Int -> Parser a -> Parser a
+isolate len (Parser m) = Parser $ \end pos ->
+    let end' = pos `plusPtr` len
+    in if end' > end
+        then throwE "isolate: unexpected end of input"
+        else m end' pos
+
 -- | If the parser fails, prepend an error message.
 (<?>) :: Parser a -> String -> Parser a
 Parser m <?> msg = Parser $ \end p ->

proto-lens/tests/parser_test.hs

@@ -1,6 +1,7 @@
 -- | Unit and property tests for our custom parsing monad.
 module Main (main) where
 
+import Control.Applicative (liftA2)
 import qualified Data.ByteString as B
 import Data.Either (isLeft)
 
@@ -18,6 +19,7 @@ main = defaultMain
     , testGroup "getBytes" testGetBytes
     , testGroup "getWord32le" testGetWord32le
     , testGroup "failure" testFailure
+    , testGroup "isolate" testIsolate
     ]
 
 testParser :: [Test]
@@ -66,6 +68,15 @@ testFailure =
             === (Left "fghij: abcde" :: Either String ())
     ]
 
+testIsolate :: [Test]
+testIsolate =
+    [ testProperty "many" $ \bs bs' ->
+        runParser (liftA2 (,) (isolate (length bs) $ manyTillEnd getWord8)
+                        (manyTillEnd getWord8))
+            (B.pack (bs ++ bs'))
+            == Right (bs, bs')
+    ]
+
 -- Since this is a test, just implement the slow stack-heavy way.
 manyTillEnd :: Parser a -> Parser [a]
 manyTillEnd p = do