Refactor DotProto.Generate (awakesecurity#104)

This PR moves the non-Haskell specific code generator utilities from `DotProto.Generate` to `DotProto.Internal`. I've gone through the `DotProto.Generate` module and made stylistic improvements---the changes are largely cosmetic. This refactor also paves the way for a Purescript code generator feature that I'm hacking on.

Major changes: 

- Pass args struct to `compileDotProtoFile` runner
- Enforce that `Path` is nonempty using `List.NonEmpty`. This removes a case from `CompileError`
- Nice combinators for writing `importDecl_` statements (see `defaultImports`)
- Pass file name to parsec; report file name in parser errors
- Make `DotProtoServiceRPC` args a separate type
- Clarify codegen steps using `foldMapM` and `foldMapOfM`. This might also improve efficiency by causing separate traversal steps (e.g. map -> sequence -> mconcat) to be done in a single pass, depending on what ghc was doing with the original code...
- Improve readability and organisation of large codegen functions

The version has been updated to `0.3.0.1` to reflect minor changes in types and dependencies.

proto3-suite.cabal

@@ -1,5 +1,5 @@
 name:                proto3-suite
-version:             0.3.0.0
+version:             0.3.0.1
 synopsis:            A low level library for writing out data in the Protocol Buffers wire format
 license:             Apache-2.0
 author:              Awake Security
@@ -27,6 +27,7 @@ library
                        Proto3.Suite.DotProto
                        Proto3.Suite.DotProto.Generate
                        Proto3.Suite.DotProto.AST
+                       Proto3.Suite.DotProto.AST.Lens
                        Proto3.Suite.DotProto.Parsing
                        Proto3.Suite.DotProto.Rendering
                        Proto3.Suite.JSONPB
@@ -102,7 +103,9 @@ test-suite tests
                        bytestring >=0.10.6.0 && <0.11.0,
                        cereal >= 0.5.1 && <0.6,
                        containers >=0.5 && < 0.7,
+                       deepseq ==1.4.*,
                        doctest,
+                       mtl ==2.2.*,
                        pretty-show >= 1.6.12 && < 2.0,
                        proto3-suite,
                        proto3-wire == 1.0.*,
@@ -122,7 +125,7 @@ executable compile-proto-file
   hs-source-dirs:      tools/compile-proto-file
   default-language:    Haskell2010
   build-depends:       base >=4.8 && <5.0
-                       , optparse-generic
+                       , optparse-applicative
                        , proto3-suite
                        , system-filepath
                        , text
@@ -135,6 +138,7 @@ executable canonicalize-proto-file
   default-language:    Haskell2010
   build-depends:       base >=4.8 && <5.0
                        , containers >=0.5 && <0.7
+                       , mtl ==2.2.*
                        , optparse-generic
                        , proto3-suite
                        , proto3-wire == 1.0.*

src/Proto3/Suite/DotProto.hs

@@ -3,3 +3,5 @@ module Proto3.Suite.DotProto (module M) where
 import Proto3.Suite.DotProto.AST       as M
 import Proto3.Suite.DotProto.Parsing   as M
 import Proto3.Suite.DotProto.Rendering as M
+-- exported for testing
+import Proto3.Suite.DotProto.Internal  as M (fieldLikeName, prefixedEnumFieldName, typeLikeName)

src/Proto3/Suite/DotProto/AST.hs

@@ -1,6 +1,7 @@
 -- | Fairly straightforward AST encoding of the .proto grammar
 
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase                 #-}
 {-# LANGUAGE RecordWildCards            #-}
 
 module Proto3.Suite.DotProto.AST
@@ -19,17 +20,21 @@ module Proto3.Suite.DotProto.AST
     , DotProtoValue(..)
     , DotProtoPrimType(..)
     , Packing(..)
-    , Path(..)
+    , Path(..), fakePath
     , DotProtoType(..)
     , DotProtoEnumValue
     , DotProtoEnumPart(..)
     , Streaming(..)
     , DotProtoServicePart(..)
+    , RPCMethod(..)
     , DotProtoMessagePart(..)
     , DotProtoField(..)
     , DotProtoReservedField(..)
   ) where
 
+import           Control.Applicative
+import           Control.Monad
+import qualified Data.List.NonEmpty        as NE
 import           Data.String               (IsString)
 import qualified Filesystem.Path.CurrentOS as FP
 import           Numeric.Natural
@@ -63,7 +68,11 @@ newtype PackageName = PackageName
 instance Show PackageName where
   show = show . getPackageName
 
-newtype Path = Path { components :: [String] } deriving (Show, Eq, Ord)
+newtype Path = Path { components :: NE.NonEmpty String } deriving (Show, Eq, Ord)
+
+-- Used for testing
+fakePath :: Path
+fakePath = Path ("fakePath" NE.:| [])
 
 data DotProtoIdentifier
   = Single String
@@ -132,6 +141,7 @@ data DotProtoDefinition
   | DotProtoService DotProtoIdentifier [DotProtoServicePart]
   deriving (Show, Eq)
 
+
 instance Arbitrary DotProtoDefinition where
   arbitrary = oneof [arbitraryMessage, arbitraryEnum]
     where
@@ -158,7 +168,7 @@ data DotProtoMeta = DotProtoMeta
   } deriving (Show, Eq)
 
 instance Arbitrary DotProtoMeta where
-  arbitrary = pure . DotProtoMeta . Path $ []
+  arbitrary = pure (DotProtoMeta fakePath)
 
 -- | This data structure represents a .proto file
 --   The actual source order of protobuf statements isn't meaningful so
@@ -293,45 +303,40 @@ data Streaming
 instance Arbitrary Streaming where
   arbitrary = elements [Streaming, NonStreaming]
 
--- [refactor] add named accessors to ServiceRPC
---            break this into two types
 data DotProtoServicePart
-  = DotProtoServiceRPC    DotProtoIdentifier
-                          (DotProtoIdentifier, Streaming)
-                          (DotProtoIdentifier, Streaming)
-                          [DotProtoOption]
+  = DotProtoServiceRPCMethod RPCMethod
   | DotProtoServiceOption DotProtoOption
   | DotProtoServiceEmpty
   deriving (Show, Eq)
 
 instance Arbitrary DotProtoServicePart where
   arbitrary = oneof
-    [ arbitraryServiceRPC
-    , arbitraryServiceOption
+    [ DotProtoServiceRPCMethod <$> arbitrary
+    , DotProtoServiceOption <$> arbitrary
     ]
-    where
-      arbitraryServiceRPC = do
-        identifier <- arbitrarySingleIdentifier
-        rpcClause0 <- arbitraryRPCClause
-        rpcClause1 <- arbitraryRPCClause
-        options    <- smallListOf arbitrary
-        return (DotProtoServiceRPC identifier rpcClause0 rpcClause1 options)
-        where
-          arbitraryRPCClause = do
-            identifier <- arbitraryIdentifier
-            streaming  <- arbitrary
-            return (identifier, streaming)
-
-      arbitraryServiceOption = do
-        option <- arbitrary
-        return (DotProtoServiceOption option)
+
+data RPCMethod = RPCMethod
+  { rpcMethodName :: DotProtoIdentifier
+  , rpcMethodRequestType :: DotProtoIdentifier
+  , rpcMethodRequestStreaming :: Streaming
+  , rpcMethodResponseType :: DotProtoIdentifier
+  , rpcMethodResponseStreaming :: Streaming
+  , rpcMethodOptions :: [DotProtoOption]
+  } deriving (Show, Eq)
+
+instance Arbitrary RPCMethod where
+  arbitrary = do
+    rpcMethodName <- arbitrarySingleIdentifier
+    rpcMethodRequestType <- arbitraryIdentifier
+    rpcMethodRequestStreaming  <- arbitrary
+    rpcMethodResponseType <- arbitraryIdentifier
+    rpcMethodResponseStreaming  <- arbitrary
+    rpcMethodOptions <- smallListOf arbitrary
+    return RPCMethod{..}
 
 data DotProtoMessagePart
   = DotProtoMessageField DotProtoField
-  | DotProtoMessageOneOf
-      { dotProtoOneOfName   :: DotProtoIdentifier
-      , dotProtoOneOfFields :: [DotProtoField]
-      }
+  | DotProtoMessageOneOf DotProtoIdentifier [DotProtoField]
   | DotProtoMessageDefinition DotProtoDefinition
   | DotProtoMessageReserved   [DotProtoReservedField]
   deriving (Show, Eq)
@@ -349,9 +354,9 @@ instance Arbitrary DotProtoMessagePart where
         return (DotProtoMessageField field)
 
       arbitraryOneOf = do
-        dotProtoOneOfName   <- arbitrarySingleIdentifier
-        dotProtoOneOfFields <- smallListOf arbitrary
-        return (DotProtoMessageOneOf {..})
+        name   <- arbitrarySingleIdentifier
+        fields <- smallListOf arbitrary
+        return (DotProtoMessageOneOf name fields)
 
       arbitraryDefinition = do
         definition <- arbitrary
@@ -429,7 +434,7 @@ arbitraryPathIdentifier :: Gen DotProtoIdentifier
 arbitraryPathIdentifier = do
   name  <- arbitraryIdentifierName
   names <- smallListOf1 arbitraryIdentifierName
-  pure . Dots . Path $ name:names
+  pure . Dots . Path $ name NE.:| names
 
 arbitraryNestedIdentifier :: Gen DotProtoIdentifier
 arbitraryNestedIdentifier = do

src/Proto3/Suite/DotProto/AST/Lens.hs

@@ -0,0 +1,9 @@
+{-# LANGUAGE TemplateHaskell            #-}
+module Proto3.Suite.DotProto.AST.Lens where
+
+import Control.Lens.TH
+import Proto3.Suite.DotProto.AST
+
+makePrisms ''DotProtoDefinition
+makePrisms ''DotProtoMessagePart
+