Made a passing test

Author: bladyjoker

lambda-buffers-codegen/src/LambdaBuffers/Codegen/Haskell/Print.hs

@@ -3,7 +3,6 @@ module LambdaBuffers.Codegen.Haskell.Print (printTyDefOpaque, printTyDefNonOpaqu
 import Control.Lens ((^.))
 import Data.Char qualified as Char
 import Data.Foldable (Foldable (toList))
-import Data.Map qualified as Map
 import Data.Map.Ordered (OMap)
 import Data.Set (Set)
 import Data.Set qualified as Set
@@ -20,8 +19,8 @@ printModuleHeader (H.MkModuleName mn) exports =
 
 printImports :: Set H.QTyName -> Doc a
 printImports imports =
-  let grouped = Map.unionsWith Set.union [Map.singleton (c, mn) (Set.singleton tn) | (c, mn, tn) <- toList imports]
-      typeImportsDocs = (\((_, H.MkModuleName mn), tns) -> "import qualified" <+> pretty mn <+> encloseSep lparen rparen comma ((\(H.MkTyName tn) -> pretty tn) <$> toList tns)) <$> Map.toList grouped
+  let grouped = Set.fromList [(c, mn) | (c, mn, _tn) <- toList imports]
+      typeImportsDocs = (\(_, H.MkModuleName mn) -> "import qualified" <+> pretty mn) <$> toList grouped
       typeImportsDoc = vsep typeImportsDocs
    in typeImportsDoc
 

lambda-buffers-codegen/src/LambdaBuffers/Codegen/Haskell/PrintM.hs

@@ -20,7 +20,6 @@ import LambdaBuffers.Codegen.Haskell.Config (Config, opaques)
 import LambdaBuffers.Codegen.Haskell.Print qualified as Print
 import LambdaBuffers.Codegen.Haskell.Syntax qualified as H
 import LambdaBuffers.Compiler.ProtoCompat.InfoLess qualified as PC
-import LambdaBuffers.Compiler.ProtoCompat.Types (Module, TyAbs (TyAbs), TyBody (OpaqueI, SumI), TyDef)
 import LambdaBuffers.Compiler.ProtoCompat.Types qualified as PC
 import Prettyprinter (Doc)
 import Proto.Compiler qualified as P
@@ -51,7 +50,7 @@ data PrintState = MkPrintState
 
 type MonadPrint m = (MonadRWS PrintRead PrintWrite PrintState m, MonadError PrintErr m)
 
-runPrint :: Config -> Module -> Either P.CompilerError (Doc ())
+runPrint :: Config -> PC.Module -> Either P.CompilerError (Doc ())
 runPrint cfg m =
   let p = runRWST (goModule m) (cfg, ModuleCtx $ m ^. #moduleName) (MkPrintState mempty mempty mempty)
       p' = runExcept p
@@ -91,16 +90,16 @@ _importClass :: MonadPrint m => (H.QClassName, [H.FunctionName]) -> m ()
 _importClass qhClassRef = modify (\s -> s {moduleClassImports = Set.union (moduleClassImports s) (Set.singleton qhClassRef)})
 
 -- | Traverse the module and collect imports, exports and type definition documents.
-goModule :: MonadPrint m => Module -> m H.ModuleName
+goModule :: MonadPrint m => PC.Module -> m H.ModuleName
 goModule m = do
   for_ (m ^. #typeDefs) (\td -> local (\(cfg, _) -> (cfg, TyDefCtx (m ^. #moduleName) td)) (goTyDef td))
   return $ H.fromLbModuleName (m ^. #moduleName)
 
-goTyDef :: MonadPrint m => TyDef -> m ()
+goTyDef :: MonadPrint m => PC.TyDef -> m ()
 goTyDef td = goTyAbs $ td ^. #tyAbs
 
-goTyAbs :: MonadPrint m => TyAbs -> m ()
-goTyAbs (TyAbs _ (OpaqueI _) _) = do
+goTyAbs :: MonadPrint m => PC.TyAbs -> m ()
+goTyAbs (PC.TyAbs _ (PC.OpaqueI _) _) = do
   cfg <- askConfig
   (currentModuleName, currentTyDef) <- askTyDefCtx
   qhTyRef <- case Map.lookup (PC.mkInfoLess currentModuleName, PC.mkInfoLess $ currentTyDef ^. #tyName) (cfg ^. opaques) of
@@ -111,16 +110,22 @@ goTyAbs (TyAbs _ (OpaqueI _) _) = do
   tell
     [ AddTyDef $ Print.printTyDefOpaque (currentTyDef ^. #tyName) qhTyRef
     ]
-goTyAbs (TyAbs args (SumI s) _) = do
+goTyAbs (PC.TyAbs args (PC.SumI s) _) = do
+  goSum s
   currentTyDef <- snd <$> askTyDefCtx
   exportTy (H.fromLbTyName (currentTyDef ^. #tyName))
   tell
     [ AddTyDef $ Print.printTyDefNonOpaque (currentTyDef ^. #tyName) args (Print.Sum s)
     ]
 
-_foreignTyRefToHaskImport :: PC.ForeignRef -> (H.CabalPackageName, H.ModuleName, H.TyName)
-_foreignTyRefToHaskImport fr =
-  ( H.cabalFromLbModuleName $ fr ^. #moduleName
-  , H.fromLbModuleName $ fr ^. #moduleName
-  , H.fromLbTyName $ fr ^. #tyName
-  )
+goSum :: MonadPrint m => PC.Sum -> m ()
+goSum s = for_ (s ^. #constructors) (\c -> goProduct (c ^. #product))
+
+goProduct :: MonadPrint m => PC.Product -> m ()
+goProduct (PC.TupleI t) = for_ (t ^. #fields) goTy
+goProduct (PC.RecordI r) = for_ (r ^. #fields) (\f -> goTy $ f ^. #fieldTy)
+
+goTy :: MonadPrint m => PC.Ty -> m ()
+goTy (PC.TyRefI (PC.ForeignI fr)) = importTy (H.fromLbForeignRef fr)
+goTy (PC.TyAppI ta) = goTy (ta ^. #tyFunc) >> for_ (ta ^. #tyArgs) goTy
+goTy _ = return ()

lambda-buffers-codegen/src/LambdaBuffers/Codegen/Haskell/Syntax.hs

@@ -1,4 +1,4 @@
-module LambdaBuffers.Codegen.Haskell.Syntax (QTyName, QClassName, CabalPackageName (..), ModuleName (..), TyName (..), ClassName (..), FunctionName (..), fromLbModuleName, cabalFromLbModuleName, fromLbTyName) where
+module LambdaBuffers.Codegen.Haskell.Syntax (QTyName, QClassName, CabalPackageName (..), ModuleName (..), TyName (..), ClassName (..), FunctionName (..), fromLbModuleName, cabalFromLbModuleName, fromLbTyName, fromLbForeignRef) where
 
 import Control.Lens ((^.))
 import Data.Text (Text)
@@ -23,3 +23,10 @@ fromLbModuleName mn = MkModuleName $ Text.intercalate "." ("LambdaBuffers" : [p
 -- TODO(bladyjoker): Figure out the Cabal package name syntax.
 cabalFromLbModuleName :: PC.ModuleName -> CabalPackageName
 cabalFromLbModuleName mn = MkCabalPackageName $ Text.intercalate "-" ([Text.toLower $ p ^. #name | p <- mn ^. #parts] <> ["-lb"])
+
+fromLbForeignRef :: PC.ForeignRef -> QTyName
+fromLbForeignRef fr =
+  ( cabalFromLbModuleName $ fr ^. #moduleName
+  , fromLbModuleName $ fr ^. #moduleName
+  , fromLbTyName $ fr ^. #tyName
+  )

lambda-buffers-codegen/test/Test/LambdaBuffers/Codegen/Haskell.hs

@@ -25,7 +25,7 @@ tests :: TestTree
 tests =
   testGroup
     "LambdaBuffers.Codegen.Haskell"
-    [testCase "should succeed" $ testPrint testCompInp testConfig ""]
+    [testCase "should succeed" $ testPrint testCompInp testConfig "module LambdaBuffers.TestMod (Either,I8,Maybe,Set) where\n\n\nimport qualified Data.Int\nimport qualified Data.Set\n\n\ndata Either a b = Either'Left a | Either'Right b\ntype I8 = Data.Int.Int8\ndata Maybe a = Maybe'Just a | Maybe'Nothing \ntype Set = Data.Set.Set\n\n\nmodule LambdaBuffers.TestMod2 (Foo,I16) where\n\n\nimport qualified Data.Int\nimport qualified LambdaBuffers.TestMod\n\n\ndata Foo a = Foo'MkFoo a I16 TestMod.I8\ntype I16 = Data.Int.Int16\n\n"]
 
 testPrint :: P.CompilerInput -> H.Config -> String -> Assertion
 testPrint compInp cfg want = do