Reworking the Compiler ProtoCompat (big one)

lambda-buffers-compiler/app/LambdaBuffers/Compiler/Cli/Compile.hs

@@ -1,19 +1,16 @@
 module LambdaBuffers.Compiler.Cli.Compile (CompileOpts (..), compile) where
 
-import Control.Lens (makeLenses)
+import Control.Lens (makeLenses, (&), (.~))
 import Control.Lens.Getter ((^.))
 import Data.ByteString qualified as BS
+import Data.ProtoLens (Message (defMessage))
 import Data.ProtoLens qualified as Pb
 import Data.ProtoLens.TextFormat qualified as PbText
 import Data.Text.Lazy qualified as Text
 import Data.Text.Lazy.IO qualified as Text
-import LambdaBuffers.Compiler.KindCheck (check)
-import LambdaBuffers.Compiler.ProtoCompat (
-  FromProtoErr (NamingError, ProtoError),
-  IsMessage (fromProto, toProto),
- )
-import LambdaBuffers.Compiler.ProtoCompat.Types qualified as ProtoCompat
-import Proto.Compiler as ProtoLib (CompilerInput, CompilerOutput)
+import LambdaBuffers.Compiler (runCompiler)
+import Proto.Compiler (CompilerError, CompilerInput, CompilerOutput)
+import Proto.Compiler_Fields (compilerError, compilerResult)
 import System.FilePath.Lens (extension)
 
 data CompileOpts = CompileOpts
@@ -24,20 +21,19 @@ data CompileOpts = CompileOpts
 
 makeLenses ''CompileOpts
 
--- NOTE(cstml) - let's use Katip instead of print.
+-- NOTE(cstml): Let's use Katip instead of print.
 
 -- | Compile LambdaBuffers modules
 compile :: CompileOpts -> IO ()
 compile opts = do
-  compIn <- readCompilerInput (opts ^. input)
-  case fromProto @CompilerInput @ProtoCompat.CompilerInput compIn of
-    Left err -> case err of
-      NamingError ne -> print $ "Encountered a naming error " <> show ne
-      ProtoError pe -> print $ "Encountered a proto error " <> show pe
-    Right compIn' -> do
-      print @String "Successfully processed the CompilerInput"
-      let result = check compIn'
-      writeCompilerOutput (opts ^. output) (toProto result)
+  compInp <- readCompilerInput (opts ^. input)
+  case runCompiler compInp of
+    Left compErr -> do
+      print @String "Encountered errors during Compilation"
+      writeCompilerError (opts ^. output) compErr
+    Right compRes -> do
+      print @String "Compilation succeeded"
+      writeCompilerOutput (opts ^. output) (defMessage & compilerResult .~ compRes)
   return ()
 
 readCompilerInput :: FilePath -> IO CompilerInput
@@ -52,7 +48,10 @@ readCompilerInput fp = do
       return $ PbText.readMessageOrDie content
     _ -> error $ "Unknown CompilerInput format " <> ext
 
-writeCompilerOutput :: FilePath -> ProtoLib.CompilerOutput -> IO ()
+writeCompilerError :: FilePath -> CompilerError -> IO ()
+writeCompilerError fp err = writeCompilerOutput fp (defMessage & compilerError .~ err)
+
+writeCompilerOutput :: FilePath -> CompilerOutput -> IO ()
 writeCompilerOutput fp cr = do
   let ext = fp ^. extension
   case ext of

lambda-buffers-compiler/lambda-buffers-compiler.cabal

@@ -107,6 +107,7 @@ library
     , text                        >=1.2
 
   exposed-modules:
+    LambdaBuffers.Compiler
     LambdaBuffers.Compiler.KindCheck
     LambdaBuffers.Compiler.KindCheck.Context
     LambdaBuffers.Compiler.KindCheck.Derivation
@@ -117,6 +118,7 @@ library
     LambdaBuffers.Compiler.KindCheck.Variable
     LambdaBuffers.Compiler.NamingCheck
     LambdaBuffers.Compiler.ProtoCompat
+    LambdaBuffers.Compiler.ProtoCompat.FromProto
     LambdaBuffers.Compiler.ProtoCompat.Types
     LambdaBuffers.Compiler.TypeClass.Pat
     LambdaBuffers.Compiler.TypeClass.Pretty
@@ -126,7 +128,7 @@ library
 
   hs-source-dirs:  src
 
--- note(cstml): should we name this something shorter? lb-cli?
+-- NOTE(cstml): should we name this something shorter? lb-cli?
 executable lambda-buffers-compiler-cli
   import:         common-language
   import:         common-imports
@@ -149,8 +151,10 @@ test-suite tests
   hs-source-dirs: test
   main-is:        Test.hs
   build-depends:
+    , containers                  >=0.6
     , lambda-buffers-compiler
     , lambda-buffers-compiler-pb  >=0.1
+    , mtl                         >=2.2
     , proto-lens                  >=0.7
     , QuickCheck                  >=2.14
     , tasty                       >=1.4
@@ -160,9 +164,10 @@ test-suite tests
 
   other-modules:
     Test.KindCheck
+    Test.LambdaBuffers.Compiler
+    Test.LambdaBuffers.Compiler.Gen
     Test.TypeClassCheck
     Test.Utils.CompilerInput
     Test.Utils.Constructors
     Test.Utils.Module
-    Test.Utils.SourceInfo
     Test.Utils.TyDef

lambda-buffers-compiler/src/LambdaBuffers/Compiler.hs

@@ -0,0 +1,16 @@
+module LambdaBuffers.Compiler (runCompiler) where
+
+import Data.ProtoLens (Message (defMessage))
+import LambdaBuffers.Compiler.KindCheck (check_)
+import LambdaBuffers.Compiler.ProtoCompat.FromProto (
+  runFromProto,
+  toProto,
+ )
+import Proto.Compiler (CompilerError, CompilerInput, CompilerResult)
+
+runCompiler :: CompilerInput -> Either CompilerError CompilerResult
+runCompiler compInp = do
+  compInp' <- runFromProto compInp
+  case check_ compInp' of
+    Left err -> Left $ toProto err
+    Right _ -> Right defMessage