Skip to content

Commit

Permalink
Merge pull request #147 from mlabs-haskell/bladyjoker/gnu-error-msg
Browse files Browse the repository at this point in the history
Aligns error reporting with the GNU standard
  • Loading branch information
bladyjoker authored Nov 22, 2023
2 parents 2e3f7df + 363d11b commit 05cdec8
Show file tree
Hide file tree
Showing 11 changed files with 89 additions and 82 deletions.
38 changes: 20 additions & 18 deletions lambda-buffers-codegen/app/LambdaBuffers/Codegen/Cli/Gen.hs
Original file line number Diff line number Diff line change
Expand Up @@ -42,11 +42,13 @@ data GenOpts = GenOpts

makeLenses ''GenOpts

logInfo :: String -> IO ()
logInfo msg = putStrLn $ "[lbg][INFO] " <> msg <> "."
logInfo :: FilePath -> String -> IO ()
logInfo "" msg = putStrLn $ msg <> " [INFO]"
logInfo fp msg = putStrLn $ fp <> ": " <> msg <> " [INFO]"

logError :: String -> IO ()
logError msg = putStrLn $ "[lbg][ERROR] " <> msg <> "."
logError :: FilePath -> String -> IO ()
logError "" msg = putStrLn $ msg <> " [ERROR]"
logError fp msg = putStrLn $ fp <> ": " <> msg <> " [ERROR]"

data Generated = Generated
{ _generatedFilePath :: FilePath
Expand All @@ -61,8 +63,8 @@ type Handler = (PC.CodegenInput -> Map (PC.InfoLess PC.ModuleName) (Either P.Err

gen :: GenOpts -> Handler -> IO ()
gen opts cont = do
logInfo $ "Codegen Input at " <> opts ^. inputFile
when (opts ^. debug) $ logInfo $ "Options received: " <> show opts
logInfo "" $ "Reading Codegen Input at " <> opts ^. inputFile
when (opts ^. debug) $ logInfo "" $ "Options received: " <> show opts
ci <- readCodegenInput (opts ^. inputFile)
ci' <- runFromProto (opts ^. outputFile) ci
ci'' <- filterToRequestedClasses' opts ci'
Expand All @@ -73,11 +75,11 @@ gen opts cont = do
then do
writeCodegenResult (opts ^. outputFile)
writePackageDeps (opts ^. genDir </> "build.json") allDeps
logInfo "Code generation successful"
logInfo (opts ^. inputFile) "Code generation successful"
else do
writeCodegenError (opts ^. outputFile) allErrors
logError "Code generation reported errors"
logInfo $ "Codegen Output at " <> opts ^. outputFile
logError (opts ^. inputFile) "Code generation failed"
logInfo "" $ "Writing Codegen Output at " <> opts ^. outputFile

instance MonadFail (Either String) where
fail = Left
Expand All @@ -90,7 +92,7 @@ filterToRequestedClasses' opts ci = do
( \cl -> do
case Config.qClassNameFromText . Text.pack $ cl of
Left err -> do
logError err
logError "" err
exitFailure
Right qcn -> return qcn
)
Expand All @@ -104,10 +106,10 @@ filterToRequestedClasses reqCls ci =
requestedClasses' = PC.classClosure ciClassRels reqCls
in
do
logInfo $ "Computed class closure: " <> unwords (Text.unpack . Config.qClassNameToText <$> toList reqCls)
logInfo "" $ "Computed class closure: " <> unwords (Text.unpack . Config.qClassNameToText <$> toList reqCls)
unless (null (reqCls `Set.difference` ciQClassNames)) $ do
logError $
"Requested to print classes that are not available in the provided context."
logError "" $
"Requested to print implementations for classes that are not available in the provided context (HINT: Import the module where the type class is defined)."
<> "\nClasses requested: "
<> unwords (Text.unpack . Config.qClassNameToText <$> toList reqCls)
<> "\nClasses available: "
Expand All @@ -130,13 +132,13 @@ collectErrorsAndDeps opts res = do
( \(mn, errOrPrint) (errs, deps) -> do
case errOrPrint of
Left err -> do
logInfo $
logInfo (opts ^. inputFile) $
"Code generation failed for module "
<> PC.withInfoLess mn (show . PC.prettyModuleName)
return (err : errs, deps)
Right gend -> do
writeFileAndCreate (opts ^. genDir </> (gend ^. generatedFilePath)) (gend ^. generatedCode)
logInfo $
logInfo (opts ^. inputFile) $
"Code generation succeeded for module "
<> PC.withInfoLess mn (show . PC.prettyModuleName)
<> " at file path "
Expand All @@ -150,7 +152,7 @@ runFromProto :: FilePath -> P.Input -> IO PC.CodegenInput
runFromProto ofp ci = case PC.codegenInputFromProto ci of
Left err -> do
writeCodegenError ofp [err]
logError $ "Code generation failed due to problems with the input file, inspect the error in " <> ofp <> " to find out the details"
logError "" $ "Code generation failed due to problems with the input file, inspect the error in " <> ofp <> " to find out the details"
exitFailure
Right ci' -> return ci'

Expand All @@ -177,7 +179,7 @@ readCodegenInput fp = do
content <- LText.readFile fp
return $ PbText.readMessageOrDie content
_ -> do
logError $ "Unknown Codegen Input format (wanted .pb or .textproto) " <> ext
logError "" $ "Unknown Codegen Input format, wanted .pb or .textproto but got " <> ext <> " (" <> fp <> ")"
exitFailure

writeCodegenError :: FilePath -> [P.Error] -> IO ()
Expand All @@ -193,7 +195,7 @@ writeCodegenOutput fp cr = do
".pb" -> BS.writeFile fp (Pb.encodeMessage cr)
".textproto" -> Text.writeFile fp (Text.pack . show $ PbText.pprintMessage cr)
_ -> do
logError $ "Unknown Codegen Output format (wanted .pb or .textproto) " <> ext
logError "" $ "Unknown Codegen Output format, wanted .pb or .textproto but got " <> ext <> " (" <> fp <> ")"
exitFailure

writePackageDeps :: FilePath -> Set Text -> IO ()
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -38,12 +38,12 @@ readHaskellConfig f = do
unless
fExists
( do
logError $ "Provided Haskell Codegen configuration file doesn't exists: " <> f
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
logError "" $ "Invalid Haskell configuration file " <> f
exitFailure
Just cfg -> return cfg
Original file line number Diff line number Diff line change
Expand Up @@ -21,7 +21,7 @@ gen :: GenOpts -> IO ()
gen opts = do
cfg <- case opts ^. config of
[] -> do
logError "No Plutarch configuration file given"
logError "" "No Plutarch configuration file given"
exitFailure
fps -> do
cfgs <- traverse readPlutarchConfig fps
Expand All @@ -37,12 +37,12 @@ readPlutarchConfig f = do
unless
fExists
( do
logError $ "Provided Plutarch Codegen configuration file doesn't exists: " <> f
logError "" $ "Provided Plutarch Codegen configuration file doesn't exists: " <> f
exitFailure
)
mayCfg <- decodeFileStrict' f
case mayCfg of
Nothing -> do
logError $ "Invalid Plutarch configuration file " <> f
logError "" $ "Invalid Plutarch configuration file " <> f
exitFailure
Just cfg -> return cfg
Original file line number Diff line number Diff line change
Expand Up @@ -38,12 +38,12 @@ readPurescriptConfig f = do
unless
fExists
( do
logError $ "Provided Purescript Codegen configuration file doesn't exists: " <> f
logError "" $ "Provided Purescript Codegen configuration file doesn't exists: " <> f
exitFailure
)
mayCfg <- decodeFileStrict f
case mayCfg of
Nothing -> do
logError $ "Invalid Purescript configuration file " <> f
logError "" $ "Invalid Purescript configuration file " <> f
exitFailure
Just cfg -> return cfg
22 changes: 12 additions & 10 deletions lambda-buffers-compiler/app/LambdaBuffers/Compiler/Cli/Compile.hs
Original file line number Diff line number Diff line change
Expand Up @@ -20,24 +20,26 @@ data CompileOpts = CompileOpts

makeLenses ''CompileOpts

logInfo :: String -> IO ()
logInfo msg = putStrLn $ "[lbc][INFO] " <> msg
logInfo :: FilePath -> String -> IO ()
logInfo "" msg = putStrLn $ msg <> " [INFO]"
logInfo fp msg = putStrLn $ fp <> ": " <> msg <> " [INFO]"

logError :: String -> IO ()
logError msg = putStrLn $ "[lbc][ERROR] " <> msg
logError :: FilePath -> String -> IO ()
logError "" msg = putStrLn $ msg <> " [ERROR]"
logError fp msg = putStrLn $ fp <> ": " <> msg <> " [ERROR]"

-- | Compile LambdaBuffers modules
compile :: CompileOpts -> IO ()
compile opts = do
logInfo $ "Compiler input at " <> opts ^. input
logInfo "" $ "Reading Compiler Input from " <> (opts ^. input)
compInp <- readCompilerInput (opts ^. input)
let compOut = runCompiler compInp
case compOut ^. maybe'error of
Nothing -> do
logInfo "Compilation succeeded"
logInfo (opts ^. input) "Compilation succeeded"
Just _ -> do
logError "Compilation failed"
logInfo $ "Compiler output at " <> opts ^. output
logError (opts ^. input) "Compilation failed"
logInfo "" $ "Writing Compiler Output at " <> (opts ^. output)
writeCompilerOutput (opts ^. output) compOut

readCompilerInput :: FilePath -> IO Input
Expand All @@ -51,7 +53,7 @@ readCompilerInput fp = do
content <- Text.readFile fp
return $ PbText.readMessageOrDie content
_ -> do
logError $ "Unknown Compiler Input format (wanted .pb or .textproto) " <> ext
logError "" $ "Unknown Compiler Input format, wanted .pb or .textproto but got " <> ext <> " (" <> fp <> ")"
exitFailure

writeCompilerOutput :: FilePath -> Output -> IO ()
Expand All @@ -61,5 +63,5 @@ writeCompilerOutput fp cr = do
".pb" -> BS.writeFile fp (Pb.encodeMessage cr)
".textproto" -> Text.writeFile fp (Text.pack . show $ PbText.pprintMessage cr)
_ -> do
logError $ "Unknown Codegen Output format (wanted .pb or .textproto) " <> ext
logError "" $ "Unknown Codegen Input format, wanted .pb or .textproto but got " <> ext <> " (" <> fp <> ")"
exitFailure
38 changes: 19 additions & 19 deletions lambda-buffers-frontend/app/LambdaBuffers/Frontend/Cli/Build.hs
Original file line number Diff line number Diff line change
Expand Up @@ -65,7 +65,7 @@ build opts = do
mods <-
either
( \e -> do
logError $ "Failed building Proto API modules: " <> show e
logError "" $ "Failed building Proto API modules: " <> show e
exitFailure
)
return
Expand All @@ -75,9 +75,9 @@ build opts = do
( \tempDir -> do
workDir <- getWorkDir opts tempDir
_compRes <- callCompiler opts workDir (defMessage & Compiler.modules .~ mods)
logInfo "Compilation OK"
logInfo "" "Compilation OK"
_cdgRes <- callCodegen opts workDir (Frontend.fres'requested res) (defMessage & Codegen.modules .~ mods)
logInfo "Codegen OK"
logInfo "" "Codegen OK"
)

getWorkDir :: BuildOpts -> FilePath -> IO FilePath
Expand All @@ -87,7 +87,7 @@ getWorkDir opts tempDir = do
unless
exists
( do
logError $ "Provided working directory " <> workDir <> " doesn't exist (did you forget to create it first?)"
logError "" $ "Provided working directory " <> workDir <> " doesn't exist (did you forget to create it first?)"
exitFailure
)
return workDir
Expand All @@ -112,7 +112,7 @@ callCompiler opts workDir compInp = do
then return $ compOut ^. Compiler.result
else do
let serrs = CompilerErrors.showErrors (compOut ^. Compiler.error)
for_ serrs logCompilerError
for_ serrs (logCompilerError lbcFp)
exitFailure

writeCompilerInput :: FilePath -> Compiler.Input -> IO ()
Expand All @@ -122,7 +122,7 @@ writeCompilerInput fp compInp = do
".pb" -> BS.writeFile fp (Pb.encodeMessage compInp)
".textproto" -> Text.writeFile fp (Text.pack . show $ PbText.pprintMessage compInp)
_ -> do
logError $ "Unknown Compiler Input format (wanted .pb or .textproto) " <> ext
logError fp $ "Unknown Compiler Input format (wanted .pb or .textproto) " <> ext
exitFailure

readCompilerOutput :: FilePath -> IO Compiler.Output
Expand All @@ -133,30 +133,30 @@ readCompilerOutput fp = do
content <- BS.readFile fp
case Pb.decodeMessage content of
Left err -> do
logError $ "Failed decoding the Compiler Output\n" <> err
logError fp $ "Failed decoding the Compiler Output\n" <> err
exitFailure
Right res -> return res
".textproto" -> do
content <- LText.readFile fp
return $ PbText.readMessageOrDie content
_ -> do
logError $ "Unknown Compiler Output format (wanted .pb or .textproto) " <> ext
logError fp $ "Unknown Compiler Output format (wanted .pb or .textproto) " <> ext
exitFailure

call :: Bool -> FilePath -> [String] -> IO ()
call dbg cliFp cliArgs = do
when dbg $ logInfo $ "Calling: " <> showCommandForUser cliFp cliArgs
when dbg $ logInfo "" $ "Calling: " <> showCommandForUser cliFp cliArgs
(exitCode, stdOut, stdErr) <- readProcessWithExitCode cliFp cliArgs ""
case exitCode of
(ExitFailure _) -> do
logError $ "Error from:" <> showCommandForUser cliFp cliArgs
logError stdErr
logError stdOut
logError cliFp stdErr
logError cliFp stdOut
logError "" $ "Error from:" <> showCommandForUser cliFp cliArgs
exitFailure
_ -> do
when dbg $ logInfo stdOut
when dbg $ logInfo stdErr
logInfo $ "Success from: " <> showCommandForUser cliFp cliArgs
when (dbg && stdOut /= "") $ logInfo cliFp stdOut
when (dbg && stdErr /= "") $ logInfo cliFp stdErr
logInfo "" $ "Success from: " <> showCommandForUser cliFp cliArgs
return ()

callCodegen :: BuildOpts -> FilePath -> [Frontend.ModuleName ()] -> Codegen.Input -> IO Codegen.Result
Expand Down Expand Up @@ -184,7 +184,7 @@ callCodegen opts workDir requestedModules compInp = do
then return $ compOut ^. Codegen.result
else do
let serrs = CodegenErrors.showErrors (compOut ^. Codegen.error)
for_ serrs logCodegenError
for_ serrs (logCodegenError lbgFp)
exitFailure

writeCodegenInput :: FilePath -> Codegen.Input -> IO ()
Expand All @@ -194,7 +194,7 @@ writeCodegenInput fp compInp = do
".pb" -> BS.writeFile fp (Pb.encodeMessage compInp)
".textproto" -> Text.writeFile fp (Text.pack . show $ PbText.pprintMessage compInp)
_ -> do
logError $ "Unknown Codegen Input format (wanted .pb or .textproto) " <> ext
logError fp $ "Unknown Codegen Input format (wanted .pb or .textproto) " <> ext
exitFailure

readCodegenOutput :: FilePath -> IO Codegen.Output
Expand All @@ -205,12 +205,12 @@ readCodegenOutput fp = do
content <- BS.readFile fp
case Pb.decodeMessage content of
Left err -> do
logError $ "Failed decoding the Codegen Output\n" <> err
logError fp $ "Failed decoding the Codegen Output\n" <> err
exitFailure
Right res -> return res
".textproto" -> do
content <- LText.readFile fp
return $ PbText.readMessageOrDie content
_ -> do
logError $ "Unknown Codegen Output format (wanted .pb or .textproto) " <> ext
logError fp $ "Unknown Codegen Output format (wanted .pb or .textproto) " <> ext
exitFailure
4 changes: 2 additions & 2 deletions lambda-buffers-frontend/app/LambdaBuffers/Frontend/Cli/Env.hs
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,7 @@ getLbcFromEnvironment = do
mayLbc <- lookupEnv lbcVar
maybe
( do
logError $ lbcVar <> " environment variable is missing"
logError "" $ lbcVar <> " environment variable is missing"
exitFailure
)
return
Expand All @@ -26,7 +26,7 @@ getLbgFromEnvironment = do
mayLbg <- lookupEnv lbgVar
maybe
( do
logError $ lbgVar <> " environment variable is missing"
logError "" $ lbgVar <> " environment variable is missing"
exitFailure
)
return
Expand Down
Loading

0 comments on commit 05cdec8

Please sign in to comment.