Merge remote-tracking branch 'origin/bladyjoker/frontend' into bladyjoker/compiler-class-check

Author: bladyjoker

flake.nix

@@ -96,7 +96,7 @@
             import-location = ./lambda-buffers-frontend/build.nix;
             additional = {
               lambda-buffers-compiler = ./lambda-buffers-compiler;
-              lambda-buffers-compiler-cli = compilerFlake.packages."lambda-buffers-compiler:exe:lambda-buffers-compiler-cli";
+              lambda-buffers-compiler-cli = compilerFlake.packages."lambda-buffers-compiler:exe:lbc";
             };
           };
           frontendFlake = flakeAbstraction frontendBuild;

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

@@ -128,8 +128,7 @@ library
 
   hs-source-dirs:  src
 
--- NOTE(cstml): should we name this something shorter? lb-cli?
-executable lambda-buffers-compiler-cli
+executable lbc
   import:         common-language
   import:         common-imports
   main-is:        Main.hs
@@ -154,7 +153,6 @@ test-suite tests
     , 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

lambda-buffers-compiler/test/Test/LambdaBuffers/Compiler/Gen.hs

@@ -1,22 +1,23 @@
 module Test.LambdaBuffers.Compiler.Gen (genCompilerInput) where
 
 import Control.Lens ((&), (.~), (^.))
-import Control.Monad.Reader (replicateM)
+import Data.Foldable (Foldable (toList))
 import Data.List qualified as List
+import Data.List.NonEmpty (NonEmpty ((:|)))
 import Data.ProtoLens (Message (defMessage))
 import Data.Text (Text)
 import Data.Text qualified as Text
 import Data.Traversable (for)
-import Proto.Compiler (ClassName, CompilerInput, ConstrName, Kind'KindRef (Kind'KIND_REF_TYPE), Module, ModuleName, ModuleNamePart, Sum, Sum'Constructor, Ty, TyAbs, TyArg, TyBody, TyDef, TyName, VarName)
-import Proto.Compiler_Fields (argKind, argName, constrName, constructors, fields, kindRef, moduleName, modules, name, ntuple, parts, tyAbs, tyArgs, tyBody, tyName, tyVar, typeDefs, varName)
+import Proto.Compiler (ClassName, CompilerInput, ConstrName, Kind'KindRef (Kind'KIND_REF_TYPE), Module, ModuleName, ModuleNamePart, Sum, Sum'Constructor, Ty, TyAbs, TyArg, TyBody, TyDef, TyName, TyRef, VarName)
+import Proto.Compiler_Fields (argKind, argName, constrName, constructors, fields, kindRef, moduleName, modules, name, ntuple, parts, tyAbs, tyArgs, tyBody, tyName, tyRef, tyVar, typeDefs, varName)
 import Proto.Compiler_Fields qualified as P
 import Test.QuickCheck qualified as QC (Gen, chooseEnum, chooseInt, elements, oneof, vectorOf)
 
 vecOf :: forall {a}. QC.Gen a -> Int -> QC.Gen [a]
-vecOf g n = replicateM n g
+vecOf = flip QC.vectorOf
 
 limit :: Int
-limit = 10
+limit = 4
 
 -- | Names
 genAlphaNum :: QC.Gen Char
@@ -73,27 +74,44 @@ genSum args = do
   return $ defMessage & constructors .~ ctors
 
 -- TODO(bladyjoker): Add TyRef, TyApp etc.
-genTy :: [TyArg] -> QC.Gen Ty
-genTy args = do
-  ar <- QC.elements args
+genTy :: [TyRef] -> [TyArg] -> QC.Gen Ty
+genTy (r : refs) (a : args) = QC.oneof [genTyVar (a :| args), genTyRef (r :| refs)]
+genTy [] (a : args) = QC.oneof [genTyVar (a :| args)]
+genTy (r : refs) [] = QC.oneof [genTyRef (r :| refs)]
+genTy _ _ = error "TODO(bladyjoker): Not yet implemented"
+
+genTyRef :: NonEmpty TyRef -> QC.Gen Ty
+genTyRef refs = do
+  r <- QC.elements (toList refs)
+  return $ defMessage & tyRef .~ r
+
+genTyVar :: NonEmpty TyArg -> QC.Gen Ty
+genTyVar args = do
+  ar <- QC.elements (toList args)
   return $ defMessage & tyVar . varName .~ (ar ^. argName)
 
 genConstructor :: [TyArg] -> ConstrName -> QC.Gen Sum'Constructor
 genConstructor args cn = do
-  tys <- QC.chooseInt (1, limit) >>= vecOf (genTy args)
+  tys <- QC.chooseInt (1, limit) >>= vecOf (genTy mempty args)
   return $
     defMessage
       & constrName .~ cn
       & P.product . ntuple . fields .~ tys
 
--- TODO(bladyjoker): Add Opaque.
 genTyBody :: [TyArg] -> QC.Gen TyBody
-genTyBody args = do
+genTyBody args = QC.oneof [genTyBodyOpaque, genTyBodySum args]
+
+genTyBodySum :: [TyArg] -> QC.Gen TyBody
+genTyBodySum args = do
   b <- genSum args
   return $ defMessage & P.sum .~ b
 
+genTyBodyOpaque :: QC.Gen TyBody
+genTyBodyOpaque = return $ defMessage & P.opaque .~ defMessage
+
 genTyAbs :: QC.Gen TyAbs
 genTyAbs = do
+  -- TODO(bladyjoker): Allow empty args
   vns <- QC.chooseInt (1, limit) >>= vecOf genVarName
   args <- for (List.nub vns) genTyArg
   body <- genTyBody args

lambda-buffers-frontend/lambda-buffers-frontend.cabal

@@ -110,7 +110,7 @@ library
     LambdaBuffers.Frontend.Syntax
     LambdaBuffers.Frontend.ToProto
 
-executable lambda-buffers-frontend-cli
+executable lbf
   import:         common-language
   build-depends:
     , base                        >=4.16

lambda-buffers-frontend/resources/good/Test.lbf

@@ -17,7 +17,8 @@ sum Either a b = Left a | Right b
 
 sum List a = Nil | List a (List a)
 
-opaque Int a
+opaque Int
+
 opaque Bytes
 
 sum Foo a = MkFoo