CLI enhancements

extras/lbf-haskell.nix

@@ -0,0 +1,58 @@
+{ pkgs, src, lbfFile, importPaths, lbf, lbg-haskell, cabalPackageName, deps ? [ ], cabalPackageVersion ? "0.1.0.0" }:
+let
+  importPaths' = builtins.concatStringsSep " " (builtins.map (imp: "--import-path ${imp}") importPaths);
+  providedDeps = builtins.concatStringsSep " " (builtins.map (dep: dep.name) deps);
+  cabalTemplate = pkgs.writeTextFile {
+    name = "lambda-buffers-cabal-template";
+    text = ''
+      cabal-version:      3.0
+      name:               ${cabalPackageName}
+      version:            ${cabalPackageVersion}
+      synopsis:           A Cabal project that contains LambdaBuffers generated Haskell modules
+      build-type:         Simple
+
+      library
+          exposed-modules: <EXPOSED_MODULES>
+          autogen-modules: <EXPOSED_MODULES>
+
+          hs-source-dirs:     autogen
+
+          default-language: Haskell2010
+          build-depends: <DEPS>
+    '';
+  };
+in
+pkgs.stdenv.mkDerivation {
+  inherit src;
+  name = cabalPackageName;
+  outputs = [ "out" "build" ];
+  buildInputs = [
+    pkgs.cabal-install
+    lbf
+    pkgs.jq
+  ];
+  buildPhase = ''
+    mkdir autogen
+    mkdir .work
+    lbf build ${importPaths'} \
+        --file ${src}/${lbfFile} \
+        --work-dir .work \
+        --gen ${lbg-haskell}/bin/lbg-haskell \
+        --gen-dir autogen
+
+    EXPOSED_MODULES=$(find autogen -name "*.hs" | while read f; do grep -Eo 'module\s+\S+\s+' $f | head -n 1 | sed -r 's/module\s+//' | sed -r 's/\s+//'; done | tr '\n' ' ')
+    echo "Found generated modules $EXPOSED_MODULES"
+    DEPS=$(echo ${providedDeps} $(cat autogen/build.json | jq -r ".[]") | tr ' ' ',' | sed 's/.$//')
+
+    cat ${cabalTemplate} \
+        | sed -r "s/<EXPOSED_MODULES>/$EXPOSED_MODULES/" \
+        | sed -r "s/<DEPS>/$DEPS/" > ${cabalPackageName}.cabal
+  '';
+
+  installPhase = ''
+    mkdir -p $out/autogen;
+    cp -r autogen $out
+    cp ${cabalPackageName}.cabal $out/${cabalPackageName}.cabal;
+    mv autogen/build.json $build;
+  '';
+}

lambda-buffers-codegen/app/LambdaBuffers/Codegen/Cli/Gen.hs

@@ -4,17 +4,21 @@ import Control.Lens (makeLenses, (&), (.~), (^.))
 import Control.Monad (when)
 import Data.Aeson (encodeFile)
 import Data.ByteString qualified as BS
-import Data.Foldable (Foldable (fold), foldrM)
+import Data.Foldable (Foldable (fold, toList), foldrM)
+import Data.List.NonEmpty (NonEmpty)
+import Data.List.NonEmpty qualified as NonEmpty
 import Data.Map (Map)
 import Data.Map qualified as Map
 import Data.ProtoLens (Message (defMessage))
 import Data.ProtoLens qualified as Pb
 import Data.ProtoLens.TextFormat qualified as PbText
 import Data.Set (Set)
+import Data.Set qualified as Set
 import Data.Text (Text)
 import Data.Text qualified as Text
 import Data.Text.IO qualified as Text
 import Data.Text.Lazy.IO qualified as LText
+import LambdaBuffers.Codegen.Config qualified as Config
 import LambdaBuffers.ProtoCompat qualified as PC
 import Proto.Codegen qualified as P
 import Proto.Codegen_Fields qualified as P
@@ -28,6 +32,7 @@ data GenOpts = GenOpts
   , _outputFile :: FilePath
   , _genDir :: FilePath
   , _debug :: Bool
+  , _requestedModules :: NonEmpty String
   }
   deriving stock (Eq, Show)
 
@@ -39,34 +44,16 @@ logInfo msg = putStrLn $ "[lbg][INFO] " <> msg <> "."
 logError :: String -> IO ()
 logError msg = putStrLn $ "[lbg][ERROR] " <> msg <> "."
 
-gen :: GenOpts -> (PC.CodegenInput -> Map (PC.InfoLess PC.ModuleName) (Either P.Error (FilePath, Text, Set Text))) -> IO ()
+type Handler = (PC.CodegenInput -> Map (PC.InfoLess PC.ModuleName) (Either P.Error (FilePath, Text, Set Text)))
+
+gen :: GenOpts -> Handler -> IO ()
 gen opts cont = do
   logInfo $ "Code generation Input at " <> opts ^. inputFile
   ci <- readCodegenInput (opts ^. inputFile)
   ci' <- runFromProto (opts ^. outputFile) ci
   initialisePrintDir (opts ^. genDir)
   let res = cont ci'
-  (allErrors, allDeps) <-
-    foldrM
-      ( \(mn, errOrPrint) (errs, deps) -> do
-          case errOrPrint of
-            Left err -> do
-              logInfo $
-                "Code generation failed for module "
-                  <> PC.withInfoLess mn (show . PC.prettyModuleName)
-              return (err : errs, deps)
-            Right (fp, printed, deps') -> do
-              logInfo $
-                "Code generation succeeded for module "
-                  <> PC.withInfoLess mn (show . PC.prettyModuleName)
-                  <> " at file path "
-                  <> (opts ^. genDir </> fp)
-              writeFileAndCreate (opts ^. genDir </> fp) printed
-              return (errs, deps <> deps')
-      )
-      ([], mempty)
-      (Map.toList res)
-
+  (allErrors, allDeps) <- collectErrorsAndDeps opts res
   if null allErrors
     then do
       writeCodegenResult (opts ^. outputFile)
@@ -77,6 +64,35 @@ gen opts cont = do
       logError "Code generation reported errors"
   logInfo $ "Code generation Output at " <> opts ^. outputFile
 
+restrictToRequestedModules :: forall {b} {a}. GenOpts -> Map (PC.InfoLess PC.ModuleName) (Either a (FilePath, Text, b)) -> IO (Map (PC.InfoLess PC.ModuleName) (Either a (FilePath, Text, b)))
+restrictToRequestedModules opts res = do
+  let uniqMns = toList $ NonEmpty.nub $ opts ^. requestedModules
+  onlyModules <- (Config.moduleNameFromText . Text.pack) `traverse` uniqMns
+  return $ Map.restrictKeys res (Set.fromList onlyModules)
+
+collectErrorsAndDeps :: forall {b} {a}. Monoid b => GenOpts -> Map (PC.InfoLess PC.ModuleName) (Either a (FilePath, Text, b)) -> IO ([a], b)
+collectErrorsAndDeps opts res = do
+  res' <- restrictToRequestedModules opts res
+  foldrM
+    ( \(mn, errOrPrint) (errs, deps) -> do
+        case errOrPrint of
+          Left err -> do
+            logInfo $
+              "Code generation failed for module "
+                <> PC.withInfoLess mn (show . PC.prettyModuleName)
+            return (err : errs, deps)
+          Right (fp, printed, deps') -> do
+            logInfo $
+              "Code generation succeeded for module "
+                <> PC.withInfoLess mn (show . PC.prettyModuleName)
+                <> " at file path "
+                <> (opts ^. genDir </> fp)
+            writeFileAndCreate (opts ^. genDir </> fp) printed
+            return (errs, deps <> deps')
+    )
+    ([], mempty)
+    (Map.toList res')
+
 runFromProto :: FilePath -> P.Input -> IO PC.CodegenInput
 runFromProto ofp ci = case PC.codegenInputFromProto ci of
   Left err -> do

lambda-buffers-codegen/app/LambdaBuffers/Codegen/Cli/GenHaskell.hs

@@ -1,17 +1,19 @@
 module LambdaBuffers.Codegen.Cli.GenHaskell (GenOpts (..), gen) where
 
 import Control.Lens (makeLenses, (^.))
-import Data.Aeson (decodeFileStrict)
+import Control.Monad (unless)
+import Data.Aeson (decodeFileStrict')
 import LambdaBuffers.Codegen.Cli.Gen (logError)
 import LambdaBuffers.Codegen.Cli.Gen qualified as Gen
 import LambdaBuffers.Codegen.Haskell (runPrint)
 import LambdaBuffers.Codegen.Haskell.Config qualified as H
 import Paths_lambda_buffers_codegen qualified as Paths
+import System.Directory (doesFileExist)
 import System.Directory.Internal.Prelude (exitFailure)
 
 data GenOpts = MkGenOpts
-  { _common :: Gen.GenOpts
-  , _config :: Maybe FilePath
+  { _config :: Maybe FilePath
+  , _common :: Gen.GenOpts
   }
 
 makeLenses 'MkGenOpts
@@ -27,7 +29,14 @@ gen opts = do
 
 readHaskellConfig :: FilePath -> IO H.Config
 readHaskellConfig f = do
-  mayCfg <- decodeFileStrict f
+  fExists <- doesFileExist f
+  unless
+    fExists
+    ( do
+        logError $ "Provided Haskell Codegen configuration file doesn't exists: " <> f
+        exitFailure
+    )
+  mayCfg <- decodeFileStrict' f
   case mayCfg of
     Nothing -> do
       logError $ "Invalid Haskell configuration file " <> f

lambda-buffers-codegen/app/LambdaBuffers/Codegen/Cli/GenPurescript.hs

@@ -1,17 +1,19 @@
 module LambdaBuffers.Codegen.Cli.GenPurescript (GenOpts (..), gen) where
 
 import Control.Lens (makeLenses, (^.))
+import Control.Monad (unless)
 import Data.Aeson (decodeFileStrict)
 import LambdaBuffers.Codegen.Cli.Gen (logError)
 import LambdaBuffers.Codegen.Cli.Gen qualified as Gen
 import LambdaBuffers.Codegen.Purescript (runPrint)
 import LambdaBuffers.Codegen.Purescript.Config qualified as H
 import Paths_lambda_buffers_codegen qualified as Paths
+import System.Directory (doesFileExist)
 import System.Exit (exitFailure)
 
 data GenOpts = MkGenOpts
-  { _common :: Gen.GenOpts
-  , _config :: Maybe FilePath
+  { _config :: Maybe FilePath
+  , _common :: Gen.GenOpts
   }
 
 makeLenses 'MkGenOpts
@@ -27,6 +29,13 @@ gen opts = do
 
 readPurescriptConfig :: FilePath -> IO H.Config
 readPurescriptConfig f = do
+  fExists <- doesFileExist f
+  unless
+    fExists
+    ( do
+        logError $ "Provided Purescript Codegen configuration file doesn't exists: " <> f
+        exitFailure
+    )
   mayCfg <- decodeFileStrict f
   case mayCfg of
     Nothing -> do

lambda-buffers-codegen/app/Main.hs

@@ -22,10 +22,12 @@ import Options.Applicative (
   showDefault,
   showHelpOnEmpty,
   showHelpOnError,
+  strArgument,
   strOption,
   subparser,
   value,
  )
+import Options.Applicative.NonEmpty (some1)
 
 data Command
   = GenHaskell Haskell.GenOpts
@@ -61,35 +63,36 @@ genOptsP =
           <> help "Run in debug mode"
           <> showDefault
       )
+    <*> some1 (strArgument (metavar "[module name]..." <> help "Modules to generate code for"))
 
 haskellGenOptsP :: Parser Haskell.GenOpts
 haskellGenOptsP =
   Haskell.MkGenOpts
-    <$> genOptsP
-    <*> optional
+    <$> optional
       ( strOption
           ( long "config"
               <> short 'c'
               <> metavar "FILEPATH"
               <> help "Configuration file for the Haskell codegen module"
           )
       )
+    <*> genOptsP
 
 purescriptGenOptsP :: Parser Purescript.GenOpts
 purescriptGenOptsP =
   Purescript.MkGenOpts
-    <$> genOptsP
-    <*> optional
+    <$> optional
       ( strOption
           ( long "config"
               <> short 'c'
               <> metavar "FILEPATH"
               <> help "Configuration file for the Purescript codegen module"
           )
       )
+    <*> genOptsP
 
-optionsP :: Parser Command
-optionsP =
+commandP :: Parser Command
+commandP =
   subparser $
     command
       "gen-haskell"
@@ -99,7 +102,7 @@ optionsP =
         (info (GenPurescript <$> purescriptGenOptsP <* helper) (progDesc "Generate Purescript code from a compiled LambdaBuffers schema"))
 
 parserInfo :: ParserInfo Command
-parserInfo = info (optionsP <**> helper) (fullDesc <> progDesc "LambdaBuffers Codegen command-line interface tool")
+parserInfo = info (commandP <**> helper) (fullDesc <> progDesc "LambdaBuffers Codegen command-line interface tool")
 
 main :: IO ()
 main = do

lambda-buffers-codegen/data/goldens/run.sh

@@ -3,8 +3,8 @@ function lbg {
     cabal run lbg -- $@
 }
 
-lbg gen-haskell -i lambda-buffers.input.textproto -o lambda-buffers.output.textproto -g haskell-autogen
+lbg gen-haskell -i lambda-buffers.input.textproto -o lambda-buffers.output.textproto -g haskell-autogen LambdaBuffers Prelude
 
-lbg gen-purescript -i lambda-buffers.input.textproto -o lambda-buffers.output.textproto -g purescript-autogen
+lbg gen-purescript -i lambda-buffers.input.textproto -o lambda-buffers.output.textproto -g purescript-autogen LambdaBuffers Prelude
 
 # ghci   -hide-all-packages -Wmissing-home-modules   -no-user-package-db   -package-db /home/bladyjoker/.cabal/store/ghc-9.2.3/package.db   -package-db /home/bladyjoker/Desktop/cardano-open-oracle-protocol/coop-plutus/dist-newstyle/packagedb/ghc-9.2.3   -package-db /home/bladyjoker/Desktop/cardano-open-oracle-protocol/coop-plutus/dist-newstyle/build/x86_64-linux/ghc-9.2.3/coop-plutus-0.1.0.0/package.conf.inplace   -package-id base-4.16.2.0   -package-id bytestring-0.11.3.1   -package-id text-1.2.5.0   -package-id containers-0.6.5.1   -package-id plutus-ledger-api-1.0.0.0-5I44wBlQkJcAkvH0pssHIv   -package-id plutus-tx-1.0.0.0-36ltsZtQ7xF5Mr0iGlXK1I   -XHaskell2010   -i/home/bladyjoker/Desktop/lambda-buffers/lambda-buffers-codegen/data/goldens/autogen   -i/home/bladyjoker/Desktop/lambda-buffers/lambda-buffers-codegen/data/goldens/runtime  ../../lambda-buffers/lambda-buffers-codegen/data/goldens/autogen/LambdaBuffers/Coop.hs

lambda-buffers-codegen/src/LambdaBuffers/Codegen/Config.hs

@@ -1,4 +1,4 @@
-module LambdaBuffers.Codegen.Config (Config (..), cfgOpaques, cfgClasses) where
+module LambdaBuffers.Codegen.Config (Config (..), cfgOpaques, cfgClasses, moduleNameFromText) where
 
 import Control.Lens (makeLenses, view)
 import Data.Aeson (FromJSON, ToJSON, parseJSON)
@@ -32,6 +32,14 @@ data JsonConfig qtn qcn = JsonConfig
 moduleNameToText :: PC.InfoLess PC.ModuleName -> Text
 moduleNameToText = Text.pack . show . (`PC.withInfoLess` PC.prettyModuleName)
 
+{- | `moduleNameFromText "Foo.Bar" = ["Foo", "Bar"]`
+ TODO(bladyjoker): Use ModuleNamePart parsers from the Compiler.
+-}
+moduleNameFromText :: MonadFail m => Text -> m (PC.InfoLess PC.ModuleName)
+moduleNameFromText txt = case Text.split (== '.') txt of
+  [] -> fail "[LambdaBuffers.Codegen.Config] Got an empty text but wanted a LambdaBuffers module name"
+  parts -> return (PC.mkInfoLess $ PC.ModuleName [PC.ModuleNamePart p def | p <- parts] def)
+
 -- | `qTyNameToText (["Foo", "Bar"], "Baz") = "Foo.Bar.Baz"`
 qTyNameToText :: PC.QTyName -> Text
 qTyNameToText (mn, tyn) = moduleNameToText mn <> "." <> PC.withInfoLess tyn (view #name)
@@ -41,11 +49,11 @@ qClassNameToText :: PC.QClassName -> Text
 qClassNameToText (mn, cn) = moduleNameToText mn <> "." <> PC.withInfoLess cn (view #name)
 
 qNameFromText :: MonadFail m => Text -> m (PC.InfoLess PC.ModuleName, Text)
-qNameFromText qn =
-  let xs = Text.split (== '.') qn
+qNameFromText txt =
+  let xs = Text.split (== '.') txt
    in case List.reverse xs of
-        [] -> fail "Got an empty text but wanted a qualified LambdaBuffers name (<module name>.<type name|class name>)"
-        [x] -> fail $ "Got a single text " <> show x <> " but wanted a qualified LambdaBuffers name (<module name>.<type name|class name>)"
+        [] -> fail "[LambdaBuffers.Codegen.Config] Got an empty text but wanted a qualified LambdaBuffers name (<module name>.<type name|class name>)"
+        [x] -> fail $ "[LambdaBuffers.Codegen.Config] Got a single text " <> show x <> " but wanted a qualified LambdaBuffers name (<module name>.<type name|class name>)"
         (n : mn) ->
           return
             ( PC.mkInfoLess $ PC.ModuleName [PC.ModuleNamePart p def | p <- List.reverse mn] def

lambda-buffers-compiler/src/LambdaBuffers/ProtoCompat/Utils.hs

@@ -10,6 +10,7 @@ import LambdaBuffers.ProtoCompat.IsCompat.Lang ()
 import LambdaBuffers.ProtoCompat.Types qualified as PC
 import Prettyprinter (Doc, Pretty (pretty), dot, encloseSep)
 import Proto.Codegen qualified as Codegen
+import Proto.Codegen_Fields qualified as Codegen
 import Proto.Compiler qualified as Compiler
 import Proto.Compiler_Fields qualified as Compiler
 import Proto.Lang qualified as Lang
@@ -50,4 +51,6 @@ instance Monoid Codegen.Error where
 instance Semigroup Codegen.Error where
   l <> r =
     defMessage
-      & Compiler.internalErrors .~ l ^. Compiler.internalErrors <> r ^. Compiler.internalErrors
+      & Codegen.internalErrors .~ l ^. Codegen.internalErrors <> r ^. Codegen.internalErrors
+      & Codegen.unsupportedOpaqueErrors .~ l ^. Codegen.unsupportedOpaqueErrors <> r ^. Codegen.unsupportedOpaqueErrors
+      & Codegen.unsupportedClassErrors .~ l ^. Codegen.unsupportedClassErrors <> r ^. Codegen.unsupportedClassErrors