diff --git a/lambda-buffers-codegen/app/LambdaBuffers/Codegen/Cli/Gen.hs b/lambda-buffers-codegen/app/LambdaBuffers/Codegen/Cli/Gen.hs index 19b08c40..2112fa06 100644 --- a/lambda-buffers-codegen/app/LambdaBuffers/Codegen/Cli/Gen.hs +++ b/lambda-buffers-codegen/app/LambdaBuffers/Codegen/Cli/Gen.hs @@ -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 @@ -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' @@ -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 @@ -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 ) @@ -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: " @@ -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 " @@ -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' @@ -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 () @@ -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 () diff --git a/lambda-buffers-codegen/app/LambdaBuffers/Codegen/Cli/GenHaskell.hs b/lambda-buffers-codegen/app/LambdaBuffers/Codegen/Cli/GenHaskell.hs index 9a6b7f72..0bf783d9 100644 --- a/lambda-buffers-codegen/app/LambdaBuffers/Codegen/Cli/GenHaskell.hs +++ b/lambda-buffers-codegen/app/LambdaBuffers/Codegen/Cli/GenHaskell.hs @@ -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 diff --git a/lambda-buffers-codegen/app/LambdaBuffers/Codegen/Cli/GenPlutarch.hs b/lambda-buffers-codegen/app/LambdaBuffers/Codegen/Cli/GenPlutarch.hs index 318e03a2..870e52e0 100644 --- a/lambda-buffers-codegen/app/LambdaBuffers/Codegen/Cli/GenPlutarch.hs +++ b/lambda-buffers-codegen/app/LambdaBuffers/Codegen/Cli/GenPlutarch.hs @@ -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 @@ -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 diff --git a/lambda-buffers-codegen/app/LambdaBuffers/Codegen/Cli/GenPurescript.hs b/lambda-buffers-codegen/app/LambdaBuffers/Codegen/Cli/GenPurescript.hs index 34c62652..9280755c 100644 --- a/lambda-buffers-codegen/app/LambdaBuffers/Codegen/Cli/GenPurescript.hs +++ b/lambda-buffers-codegen/app/LambdaBuffers/Codegen/Cli/GenPurescript.hs @@ -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 diff --git a/lambda-buffers-compiler/app/LambdaBuffers/Compiler/Cli/Compile.hs b/lambda-buffers-compiler/app/LambdaBuffers/Compiler/Cli/Compile.hs index dbbfb41d..1220627b 100644 --- a/lambda-buffers-compiler/app/LambdaBuffers/Compiler/Cli/Compile.hs +++ b/lambda-buffers-compiler/app/LambdaBuffers/Compiler/Cli/Compile.hs @@ -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 @@ -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 () @@ -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 diff --git a/lambda-buffers-frontend/app/LambdaBuffers/Frontend/Cli/Build.hs b/lambda-buffers-frontend/app/LambdaBuffers/Frontend/Cli/Build.hs index f88e2fd1..996fbdb5 100644 --- a/lambda-buffers-frontend/app/LambdaBuffers/Frontend/Cli/Build.hs +++ b/lambda-buffers-frontend/app/LambdaBuffers/Frontend/Cli/Build.hs @@ -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 @@ -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 @@ -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 @@ -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 () @@ -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 @@ -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 @@ -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 () @@ -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 @@ -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 diff --git a/lambda-buffers-frontend/app/LambdaBuffers/Frontend/Cli/Env.hs b/lambda-buffers-frontend/app/LambdaBuffers/Frontend/Cli/Env.hs index 313a1ffe..8d3f2b9f 100644 --- a/lambda-buffers-frontend/app/LambdaBuffers/Frontend/Cli/Env.hs +++ b/lambda-buffers-frontend/app/LambdaBuffers/Frontend/Cli/Env.hs @@ -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 @@ -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 diff --git a/lambda-buffers-frontend/app/LambdaBuffers/Frontend/Cli/Utils.hs b/lambda-buffers-frontend/app/LambdaBuffers/Frontend/Cli/Utils.hs index f2847bcc..f4664482 100644 --- a/lambda-buffers-frontend/app/LambdaBuffers/Frontend/Cli/Utils.hs +++ b/lambda-buffers-frontend/app/LambdaBuffers/Frontend/Cli/Utils.hs @@ -1,5 +1,6 @@ module LambdaBuffers.Frontend.Cli.Utils (logInfo, logError, logFrontendError, logCompilerError, logCodegenError, toCodegenCliModuleName, checkExists, FileOrDir (..)) where +import Data.Foldable (for_) import Data.List (intercalate) import Data.Text qualified as Text import LambdaBuffers.Frontend (FrontendError) @@ -8,20 +9,22 @@ import LambdaBuffers.Frontend.Syntax qualified as Frontend import System.Directory (doesPathExist) import System.Exit (exitFailure) -logInfo :: String -> IO () -logInfo msg = putStrLn $ "[lbf][INFO] " <> msg +logInfo :: FilePath -> String -> IO () +logInfo "" msg = putStrLn $ msg <> " [INFO]" +logInfo fp msg = for_ (lines msg) $ \l -> putStrLn $ fp <> ": " <> l <> " [INFO]" -logError :: String -> IO () -logError msg = putStrLn $ "[lbf][ERROR] " <> msg +logError :: FilePath -> String -> IO () +logError "" msg = putStrLn $ msg <> " [ERROR]" +logError fp msg = for_ (lines msg) $ \l -> putStrLn $ fp <> ": " <> l <> " [ERROR]" logFrontendError :: FrontendError -> IO () -logFrontendError err = putStrLn $ "[lbf][ERROR]" <> show err +logFrontendError err = putStrLn $ show err <> " [ERROR]" -logCompilerError :: String -> IO () -logCompilerError msg = putStrLn $ "[lbf][ERROR][COMPILER]" <> msg +logCompilerError :: FilePath -> String -> IO () +logCompilerError lbcFp msg = putStrLn $ lbcFp <> ":" <> msg <> " [ERROR]" -logCodegenError :: String -> IO () -logCodegenError msg = putStrLn $ "[lbf][ERROR][CODEGEN]" <> msg +logCodegenError :: FilePath -> String -> IO () +logCodegenError lbgFp msg = putStrLn $ lbgFp <> ":" <> msg <> " [ERROR]" -- NOTE(bladyjoker): Consider using the proto to supply requested modules. toCodegenCliModuleName :: Frontend.ModuleName () -> String @@ -35,7 +38,7 @@ checkExists fileOrDir purpose path = do if exists then return () else do - logError $ + logError "" $ "The provided " <> purpose <> " " diff --git a/lambda-buffers-frontend/src/LambdaBuffers/Frontend/Errors/Frontend.hs b/lambda-buffers-frontend/src/LambdaBuffers/Frontend/Errors/Frontend.hs index 7e078739..7f9805fb 100644 --- a/lambda-buffers-frontend/src/LambdaBuffers/Frontend/Errors/Frontend.hs +++ b/lambda-buffers-frontend/src/LambdaBuffers/Frontend/Errors/Frontend.hs @@ -58,7 +58,7 @@ showOneLine :: Doc a -> String showOneLine d = (renderShowS . layoutPretty (defaultLayoutOptions {layoutPageWidth = Unbounded}) $ d) "" prettyContext :: ModuleName SourceInfo -> SourceInfo -> Doc ann -prettyContext currentModuleName sourceInfo = brackets (pretty sourceInfo) <> brackets ("module" <+> pretty currentModuleName) +prettyContext currentModuleName sourceInfo = pretty sourceInfo <> ":" <+> brackets ("module" <+> pretty currentModuleName) data ImportedNotFound = MkImportedNotFound diff --git a/lambda-buffers-frontend/src/LambdaBuffers/Frontend/PPrint.hs b/lambda-buffers-frontend/src/LambdaBuffers/Frontend/PPrint.hs index 507e2234..8de6cec2 100644 --- a/lambda-buffers-frontend/src/LambdaBuffers/Frontend/PPrint.hs +++ b/lambda-buffers-frontend/src/LambdaBuffers/Frontend/PPrint.hs @@ -9,7 +9,7 @@ module LambdaBuffers.Frontend.PPrint (prettyTyInner, prettyTyTopLevel) where import Data.List (sort) import Data.Text qualified as Text import LambdaBuffers.Frontend.Syntax (ClassConstraint (ClassConstraint), ClassDef (ClassDef), ClassName (ClassName), ClassRef (ClassRef), ConstrName (ConstrName), Constraint (Constraint), Constructor (Constructor), Derive (Derive), Field (Field), FieldName (FieldName), Import (Import), InstanceClause (InstanceClause), Module (Module), ModuleAlias (ModuleAlias), ModuleName (ModuleName), ModuleNamePart (ModuleNamePart), Name (Name), Product (Product), Record (Record), SourceInfo (SourceInfo), SourcePos (SourcePos), Statement (StClassDef, StDerive, StInstanceClause, StTyDef), Sum (Sum), Ty (TyApp, TyRef', TyVar), TyArg (TyArg), TyBody (Opaque, ProductBody, RecordBody, SumBody), TyDef (TyDef), TyName (TyName), TyRef (TyRef), VarName (VarName), kwClassDef, kwDerive, kwInstance, kwTyDefOpaque, tyBodyToTyDefKw) -import Prettyprinter (Doc, Pretty (pretty), align, brackets, colon, comma, concatWith, encloseSep, equals, group, hsep, lbrace, line, lparen, parens, pipe, rbrace, rparen, sep, space, (<+>)) +import Prettyprinter (Doc, Pretty (pretty), align, colon, comma, concatWith, encloseSep, equals, group, hsep, lbrace, line, lparen, pipe, rbrace, rparen, sep, space, (<+>)) import Text.Parsec qualified as Parsec import Text.Parsec.Error qualified as Parsec @@ -161,13 +161,13 @@ instance Pretty info => Pretty (Constructor info) where pretty (Constructor cn p _info) = group $ hsep [pretty cn, pretty p] instance Pretty SourceInfo where - pretty (SourceInfo fn pos pos') = pretty fn <> ":" <> "(" <> pretty pos <> ")-(" <> pretty pos' <> ")" + pretty (SourceInfo fn pos pos') = pretty fn <> ":" <> pretty pos <> "-" <> pretty pos' instance Pretty SourcePos where - pretty (SourcePos r c) = pretty r <> ":" <> pretty c + pretty (SourcePos r c) = pretty r <> "." <> pretty c instance Pretty Parsec.ParseError where - pretty pe = brackets (pretty (Parsec.errorPos pe)) <+> pretty (Parsec.showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" $ Parsec.errorMessages pe) + pretty pe = pretty (Parsec.errorPos pe) <> ":" <+> pretty (Parsec.showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" $ Parsec.errorMessages pe) instance Pretty Parsec.SourcePos where - pretty sp = pretty (Parsec.sourceName sp) <> ":" <> parens (pretty (Parsec.sourceLine sp) <> ":" <> pretty (Parsec.sourceColumn sp)) + pretty sp = pretty (Parsec.sourceName sp) <> ":" <> pretty (Parsec.sourceLine sp) <> "." <> pretty (Parsec.sourceColumn sp) diff --git a/lambda-buffers-frontend/test/Test/LambdaBuffers/Frontend.hs b/lambda-buffers-frontend/test/Test/LambdaBuffers/Frontend.hs index 92ca207c..650a3a26 100644 --- a/lambda-buffers-frontend/test/Test/LambdaBuffers/Frontend.hs +++ b/lambda-buffers-frontend/test/Test/LambdaBuffers/Frontend.hs @@ -29,61 +29,61 @@ frontendErrorTests dataDir = fileIn = workDir "A.lbf" fileErr = fileIn errOrMod <- runFrontend [workDir] [fileIn] - assertError ("[" <> fileErr <> ":(5:1)-(5:12)][module A] Duplicate type definition with the name A") errOrMod + assertError (fileErr <> ":5.1-5.12: [module A] Duplicate type definition with the name A") errOrMod , testCase "Import cycle found" $ do let workDir = dataDir "import_cycle_found" fileIn = workDir "A.lbf" fileErr = workDir "C.lbf" errOrMod <- runFrontend [workDir] [fileIn] - assertError ("[" <> fileErr <> ":(3:1)-(3:9)][module C] Tried to load module A which constitutes a cycle [B, A, ]") errOrMod + assertError (fileErr <> ":3.1-3.9: [module C] Tried to load module A which constitutes a cycle [B, A, ]") errOrMod , testCase "Imported symbol not found" $ do let workDir = dataDir "imported_not_found" fileIn = workDir "A.lbf" fileErr = fileIn errOrMod <- runFrontend [workDir] [fileIn] - assertError ("[" <> fileErr <> ":(3:17)-(3:18)][module A] Name C not found in module B, did you mean one of the types: A B. Or did you mean one of the classes: ") errOrMod + assertError (fileErr <> ":3.17-3.18: [module A] Name C not found in module B, did you mean one of the types: A B. Or did you mean one of the classes: ") errOrMod , testCase "Invalid module filepath" $ do let workDir = dataDir "invalid_module_filepath" fileIn = workDir "A.lbf" fileErr = fileIn errOrMod <- runFrontend [workDir] [fileIn] - assertError ("[" <> fileErr <> ":(1:8)-(1:13)][module A.B.C] File name " <> dataDir <> "/invalid_module_filepath/A.lbf doesn't match module name A.B.C expected A/B/C.lbf") errOrMod + assertError (fileErr <> ":1.8-1.13: [module A.B.C] File name " <> dataDir <> "/invalid_module_filepath/A.lbf doesn't match module name A.B.C expected A/B/C.lbf") errOrMod , testCase "Module not found" $ do let workDir = dataDir "module_not_found" fileIn = workDir "A.lbf" fileErr = fileIn errOrMod <- runFrontend [workDir] [fileIn] - assertError ("[" <> fileErr <> ":(3:1)-(3:9)][module A] Module B not found in available import paths [" <> dataDir <> "/module_not_found]") errOrMod + assertError (fileErr <> ":3.1-3.9: [module A] Module B not found in available import paths [" <> dataDir <> "/module_not_found]") errOrMod , testCase "Module parse error" $ do let workDir = dataDir "module_parse_error" fileIn = workDir "A.lbf" fileErr = fileIn errOrMod <- runFrontend [workDir] [fileIn] - assertError ("[" <> fileErr <> ":(3:1)] \nunexpected 't'\nexpecting import statement, type definition, class definition, instance clause, derive statement or end of input") errOrMod + assertError (fileErr <> ":3.1: \nunexpected 't'\nexpecting import statement, type definition, class definition, instance clause, derive statement or end of input") errOrMod , testCase "Multiple modules found" $ do let workDir = dataDir "multiple_modules_found" fileIn = workDir "A.lbf" fileErr = fileIn errOrMod <- runFrontend [workDir, workDir "another_import_path"] [fileIn] - assertError ("[" <> fileErr <> ":(3:1)-(3:9)][module A] Module B found in multiple files [" <> dataDir <> "/multiple_modules_found/B.lbf, " <> dataDir <> "/multiple_modules_found/another_import_path/B.lbf]") errOrMod + assertError (fileErr <> ":3.1-3.9: [module A] Module B found in multiple files [" <> dataDir <> "/multiple_modules_found/B.lbf, " <> dataDir <> "/multiple_modules_found/another_import_path/B.lbf]") errOrMod , testCase "Symbol already imported" $ do let workDir = dataDir "symbol_already_imported" fileIn = workDir "A.lbf" fileErr = fileIn errOrMod <- runFrontend [workDir] [fileIn] - assertError ("[" <> fileErr <> ":(4:1)-(4:9)][module A] Type name A already imported from module B") errOrMod + assertError (fileErr <> ":4.1-4.9: [module A] Type name A already imported from module B") errOrMod , testCase "Type definition name conflict" $ do let workDir = dataDir "tydef_name_conflict" fileIn = workDir "A.lbf" fileErr = fileIn errOrMod <- runFrontend [workDir] [fileIn] - assertError ("[" <> fileErr <> ":(5:5)-(5:6)][module A] Type name A conflicts with an imported type name from module B") errOrMod + assertError (fileErr <> ":5.5-5.6: [module A] Type name A conflicts with an imported type name from module B") errOrMod , testCase "Type reference not found" $ do let workDir = dataDir "tyref_not_found" fileIn = workDir "A.lbf" fileErr = fileIn errOrMod <- runFrontend [workDir] [fileIn] - assertError ("[" <> fileErr <> ":(6:13)-(6:28)][module A] Type WhereIsThisType not found in the module's scope A B C B.B C.C") errOrMod + assertError (fileErr <> ":6.13-6.28: [module A] Type WhereIsThisType not found in the module's scope A B C B.B C.C") errOrMod ] assertError :: String -> Either FrontendError FrontendResult -> Assertion