From 409c9cee761eb6d0af824241be1a6d318ee81448 Mon Sep 17 00:00:00 2001 From: Decio Ferreira Date: Fri, 6 Mar 2026 23:52:24 +0000 Subject: [PATCH 01/11] feat: enhance warning reporting and handling in the compiler --- lib/index.js | 2 +- src/API/Main.elm | 16 ++- src/API/Make.elm | 49 ++++++- src/Builder/Build.elm | 216 ++++++++++++++++++----------- src/Builder/Generate.elm | 6 +- src/Builder/Guida/Details.elm | 2 +- src/Builder/Reporting.elm | 4 +- src/Builder/Stuff.elm | 6 + src/Compiler/Compile.elm | 70 ++++++---- src/Compiler/Reporting/Error.elm | 10 ++ src/Compiler/Reporting/Report.elm | 12 +- src/Compiler/Reporting/Warning.elm | 139 ++++++++++++++++++- src/Terminal/Make.elm | 167 ++++++++++++++++------ tests/api.test.js | 24 ++++ 14 files changed, 548 insertions(+), 175 deletions(-) diff --git a/lib/index.js b/lib/index.js index 2bc7a3e9c..21b6e6972 100644 --- a/lib/index.js +++ b/lib/index.js @@ -327,7 +327,7 @@ module.exports = { package: !!options.package }); }, - make: async (config, path, options) => { + make: async (config, path, options = {}) => { return await runGuida(config, { command: "make", path, diff --git a/src/API/Main.elm b/src/API/Main.elm index eec913062..127a17b0c 100644 --- a/src/API/Main.elm +++ b/src/API/Main.elm @@ -52,8 +52,20 @@ app = |> Task.bind (\result -> case result of - Ok output -> - exitWithResponse (Encode.object [ ( "output", Encode.string output ) ]) + Ok ( output, warnings ) -> + let + warningsJson : Encode.Value + warningsJson = + E.encodeUgly (E.list Error.warningReportToJson warnings) + |> Decode.decodeString Decode.value + |> Result.withDefault Encode.null + in + exitWithResponse + (Encode.object + [ ( "output", Encode.string output ) + , ( "warnings", warningsJson ) + ] + ) Err error -> exitWithResponse (Encode.object [ ( "error", Encode.string (E.encodeUgly (Exit.toJson (Exit.makeToReport error))) ) ]) diff --git a/src/API/Make.elm b/src/API/Make.elm index 3c6e33b26..edd70b63c 100644 --- a/src/API/Make.elm +++ b/src/API/Make.elm @@ -13,6 +13,7 @@ module API.Make exposing import Builder.BackgroundWriter as BW import Builder.Build as Build +import Builder.File as File import Builder.Generate as Generate import Builder.Guida.Details as Details import Builder.Reporting as Reporting @@ -21,7 +22,12 @@ import Builder.Stuff as Stuff import Compiler.AST.Optimized as Opt import Compiler.Data.NonEmptyList as NE import Compiler.Generate.Html as Html +import Compiler.Generate.Target exposing (Target) import Compiler.Guida.ModuleName as ModuleName +import Compiler.Reporting.Render.Code as Code +import Compiler.Reporting.Render.Type.Localizer as L +import Compiler.Reporting.Report as Report +import Compiler.Reporting.Warning as W import Maybe.Extra as Maybe import Task exposing (Task) import Terminal.Terminal.Internal exposing (Parser(..)) @@ -52,7 +58,7 @@ type ReportType -- RUN -run : String -> Flags -> Task Never (Result Exit.Make String) +run : String -> Flags -> Task Never (Result Exit.Make ( String, List Report.WarningModuleReport )) run path flags = Stuff.findRoot |> Task.bind @@ -66,7 +72,7 @@ run path flags = ) -runHelp : Stuff.Root -> String -> Flags -> Task Never (Result Exit.Make String) +runHelp : Stuff.Root -> String -> Flags -> Task Never (Result Exit.Make ( String, List Report.WarningModuleReport )) runHelp root path (Flags debug optimize withSourceMaps) = BW.withScope (\scope -> @@ -85,15 +91,30 @@ runHelp root path (Flags debug optimize withSourceMaps) = (\details -> buildPaths style root details (NE.Nonempty path []) |> Task.bind - (\artifacts -> + (\((Build.Artifacts warnings _ _ _ _) as artifacts) -> case getMains artifacts of [] -> -- Task.pure () crash "No main!" [ name ] -> - toBuilder withSourceMaps Html.leadingLines root details desiredMode artifacts - |> Task.bind (Task.pure << Html.sandwich (Stuff.rootToTarget root) name) + let + target : Target + target = + Stuff.rootToTarget root + + buildOutput : Task Exit.Make String + buildOutput = + toBuilder withSourceMaps Html.leadingLines root details desiredMode artifacts + |> Task.fmap (Html.sandwich target name) + + buildWarnings : Task Exit.Make (List Report.WarningModuleReport) + buildWarnings = + warnings + |> Utils.listTraverse (warningToReport target) + |> Task.mapError never + in + Task.map2 Tuple.pair buildOutput buildWarnings _ -> crash "TODO" @@ -135,11 +156,27 @@ buildPaths style root details paths = +-- EXTRACT WARNINGS + + +warningToReport : Target -> W.Module -> Task Never Report.WarningModuleReport +warningToReport target { absolutePath, name, warnings } = + File.readUtf8 absolutePath + |> Task.fmap + (\sourceCode -> + { path = absolutePath + , name = name + , warnings = List.map (W.toReport target L.empty (Code.toSource sourceCode)) warnings + } + ) + + + -- GET MAINS getMains : Build.Artifacts -> List ModuleName.Raw -getMains (Build.Artifacts _ _ roots modules) = +getMains (Build.Artifacts _ _ _ roots modules) = List.filterMap (getMain modules) (NE.toList roots) diff --git a/src/Builder/Build.elm b/src/Builder/Build.elm index ce7f8e089..dbb9c68bd 100644 --- a/src/Builder/Build.elm +++ b/src/Builder/Build.elm @@ -46,6 +46,7 @@ import Compiler.Reporting.Error.Docs as EDocs import Compiler.Reporting.Error.Import as Import import Compiler.Reporting.Error.Syntax as Syntax import Compiler.Reporting.Render.Type.Localizer as L +import Compiler.Reporting.Warning as W import Data.Graph as Graph import Data.Map as Dict exposing (Dict) import Data.Set as EverySet @@ -208,7 +209,7 @@ fromExposed docsDecoder docsEncoder style root details docsGoal ((NE.Nonempty e type Artifacts - = Artifacts Pkg.Name Dependencies (NE.Nonempty Root) (List Module) + = Artifacts (List W.Module) Pkg.Name Dependencies (NE.Nonempty Root) (List Module) type Module @@ -300,7 +301,7 @@ fromPaths style root details paths = getRootNames : Artifacts -> NE.Nonempty ModuleName.Raw -getRootNames (Artifacts _ _ roots _) = +getRootNames (Artifacts _ _ _ roots _) = NE.map getRootName roots @@ -486,9 +487,9 @@ type alias ResultDict = type BResult - = RNew Details.Local I.Interface Opt.LocalGraph (Maybe Docs.Module) - | RSame Details.Local I.Interface Opt.LocalGraph (Maybe Docs.Module) - | RCached Bool Details.BuildID (MVar CachedInterface) + = RNew W.Module Details.Local I.Interface Opt.LocalGraph (Maybe Docs.Module) + | RSame W.Module Details.Local I.Interface Opt.LocalGraph (Maybe Docs.Module) + | RCached (Maybe W.Module) Bool Details.BuildID (MVar CachedInterface) | RNotFound Import.Problem | RProblem Error.Module | RBlocked @@ -528,10 +529,14 @@ checkModule ((Env _ root projectType _ _ _ _) as env) foreigns resultsMVar name ) DepsSame _ _ -> - Utils.newMVar cachedInterfaceEncoder Unneeded - |> Task.fmap - (\mvar -> - RCached hasMain lastChange mvar + File.readBinary W.moduleDecoder (Stuff.guidaw (Stuff.rootPath root) name) + |> Task.bind + (\maybeWarningModule -> + Utils.newMVar cachedInterfaceEncoder Unneeded + |> Task.fmap + (\mvar -> + RCached maybeWarningModule hasMain lastChange mvar + ) ) DepsBlock -> @@ -641,13 +646,13 @@ checkDepsHelp root results deps new same cached importProblems isBlocked lastDep |> Task.bind (\result -> case result of - RNew (Details.Local _ _ _ _ lastChange _) iface _ _ -> + RNew _ (Details.Local _ _ _ _ lastChange _) iface _ _ -> checkDepsHelp root results otherDeps (( dep, iface ) :: new) same cached importProblems isBlocked (max lastChange lastDepChange) lastCompile - RSame (Details.Local _ _ _ _ lastChange _) iface _ _ -> + RSame _ (Details.Local _ _ _ _ lastChange _) iface _ _ -> checkDepsHelp root results otherDeps new (( dep, iface ) :: same) cached importProblems isBlocked (max lastChange lastDepChange) lastCompile - RCached _ lastChange mvar -> + RCached _ _ lastChange mvar -> checkDepsHelp root results otherDeps new same (( dep, mvar ) :: cached) importProblems isBlocked (max lastChange lastDepChange) lastCompile RNotFound prob -> @@ -966,7 +971,7 @@ checkInside name p1 status = compile : Target -> Env -> DocsNeed -> Details.Local -> String -> Dict String ModuleName.Raw I.Interface -> Src.Module -> Task Never BResult -compile target (Env key root projectType _ buildID _ _) docsNeed (Details.Local path time deps main lastChange _) source ifaces modul = +compile target (Env key root projectType _ buildID _ _) docsNeed (Details.Local path ((File.Time posix) as time) deps main lastChange _) source ifaces modul = let pkg : Pkg.Name pkg = @@ -974,7 +979,7 @@ compile target (Env key root projectType _ buildID _ _) docsNeed (Details.Local in Compile.compile target root pkg ifaces modul |> Task.bind - (\result -> + (\( warnings, result ) -> case result of Ok (Compile.Artifacts canonical annotations objects) -> case makeDocs target docsNeed canonical of @@ -1000,56 +1005,65 @@ compile target (Env key root projectType _ buildID _ _) docsNeed (Details.Local File.writeBinary Opt.localGraphEncoder (Stuff.guidao (Stuff.rootPath root) name) objects |> Task.bind (\_ -> - File.readBinary I.interfaceDecoder guidai + let + warningModule : W.Module + warningModule = + W.Module (Src.getName modul) path posix source warnings + in + File.writeBinary W.moduleEncoder (Stuff.guidaw (Stuff.rootPath root) name) warningModule |> Task.bind - (\maybeOldi -> - case maybeOldi of - Just oldi -> - if oldi == iface then - -- iface should be fully forced by equality check - Reporting.report key Reporting.BDone - |> Task.fmap - (\_ -> - let - local : Details.Local - local = - Details.Local path time deps main lastChange buildID - in - RSame local iface objects docs - ) - - else - File.writeBinary I.interfaceEncoder guidai iface - |> Task.bind - (\_ -> + (\_ -> + File.readBinary I.interfaceDecoder guidai + |> Task.bind + (\maybeOldi -> + case maybeOldi of + Just oldi -> + if oldi == iface then + -- iface should be fully forced by equality check Reporting.report key Reporting.BDone |> Task.fmap (\_ -> let local : Details.Local local = - Details.Local path time deps main buildID buildID + Details.Local path time deps main lastChange buildID in - RNew local iface objects docs + RSame warningModule local iface objects docs + ) + + else + File.writeBinary I.interfaceEncoder guidai iface + |> Task.bind + (\_ -> + Reporting.report key Reporting.BDone + |> Task.fmap + (\_ -> + let + local : Details.Local + local = + Details.Local path time deps main buildID buildID + in + RNew warningModule local iface objects docs + ) ) - ) - _ -> - -- iface may be lazy still - File.writeBinary I.interfaceEncoder guidai iface - |> Task.bind - (\_ -> - Reporting.report key Reporting.BDone - |> Task.fmap + _ -> + -- iface may be lazy still + File.writeBinary I.interfaceEncoder guidai iface + |> Task.bind (\_ -> - let - local : Details.Local - local = - Details.Local path time deps main buildID buildID - in - RNew local iface objects docs + Reporting.report key Reporting.BDone + |> Task.fmap + (\_ -> + let + local : Details.Local + local = + Details.Local path time deps main buildID buildID + in + RNew warningModule local iface objects docs + ) ) - ) + ) ) ) @@ -1083,13 +1097,13 @@ writeDetails root (Details.Details time outline buildID locals foreigns extras) addNewLocal : ModuleName.Raw -> BResult -> Dict String ModuleName.Raw Details.Local -> Dict String ModuleName.Raw Details.Local addNewLocal name result locals = case result of - RNew local _ _ _ -> + RNew _ local _ _ _ -> Dict.insert identity name local locals - RSame local _ _ _ -> + RSame _ local _ _ _ -> Dict.insert identity name local locals - RCached _ _ _ -> + RCached _ _ _ _ -> locals RNotFound _ -> @@ -1130,13 +1144,13 @@ finalizeExposed root docsGoal exposed results = addErrors : BResult -> List Error.Module -> List Error.Module addErrors result errors = case result of - RNew _ _ _ _ -> + RNew _ _ _ _ _ -> errors - RSame _ _ _ _ -> + RSame _ _ _ _ _ -> errors - RCached _ _ _ -> + RCached _ _ _ _ -> errors RNotFound _ -> @@ -1155,16 +1169,47 @@ addErrors result errors = errors +gatherWarnings : BResult -> List W.Module -> List W.Module +gatherWarnings result warnings = + case result of + RNew ws _ _ _ _ -> + ws :: warnings + + RSame ws _ _ _ _ -> + ws :: warnings + + RCached Nothing _ _ _ -> + warnings + + RCached (Just ws) _ _ _ -> + ws :: warnings + + RNotFound _ -> + warnings + + RProblem _ -> + warnings + + RBlocked -> + warnings + + RForeign _ -> + warnings + + RKernel -> + warnings + + addImportProblems : Dict String ModuleName.Raw BResult -> ModuleName.Raw -> List ( ModuleName.Raw, Import.Problem ) -> List ( ModuleName.Raw, Import.Problem ) addImportProblems results name problems = case Utils.find identity name results of - RNew _ _ _ _ -> + RNew _ _ _ _ _ -> problems - RSame _ _ _ _ -> + RSame _ _ _ _ _ -> problems - RCached _ _ _ -> + RCached _ _ _ _ -> problems RNotFound p -> @@ -1255,13 +1300,13 @@ finalizeDocs goal results = toDocs : BResult -> Maybe Docs.Module toDocs result = case result of - RNew _ _ _ d -> + RNew _ _ _ _ d -> d - RSame _ _ _ d -> + RSame _ _ _ _ d -> d - RCached _ _ _ -> + RCached _ _ _ _ -> Nothing RNotFound _ -> @@ -1380,7 +1425,7 @@ finalizeReplArtifacts ((Env _ root projectType _ _ _ _) as env) source ((Src.Mod compileInput ifaces = Compile.compile (Stuff.rootToTarget root) root pkg ifaces modul |> Task.fmap - (\result -> + (\( _, result ) -> case result of Ok (Compile.Artifacts ((Can.Module name _ _ _ _ _ _ _) as canonical) annotations objects) -> let @@ -1739,7 +1784,7 @@ compileOutside (Env key root projectType _ _ _ _) (Details.Local path time _ _ _ in Compile.compile (Stuff.rootToTarget root) root pkg ifaces modul |> Task.bind - (\result -> + (\( _, result ) -> case result of Ok (Compile.Artifacts canonical annotations objects) -> Reporting.report key Reporting.BDone @@ -1766,8 +1811,13 @@ toArtifacts (Env _ root projectType _ _ _ _) foreigns results rootResults = Err (Exit.BuildBadModules (Stuff.rootPath root) e es) Ok roots -> + let + warnings : List W.Module + warnings = + Dict.foldr compare (\_ -> gatherWarnings) [] results + in Ok <| - Artifacts (projectTypeToPkg projectType) foreigns roots <| + Artifacts warnings (projectTypeToPkg projectType) foreigns roots <| Dict.foldr compare addInside (NE.foldr addOutside [] rootResults) results @@ -1819,13 +1869,13 @@ gatherProblemsOrMains results (NE.Nonempty rootResult rootResults) = addInside : ModuleName.Raw -> BResult -> List Module -> List Module addInside name result modules = case result of - RNew _ iface objs _ -> + RNew _ _ iface objs _ -> Fresh name iface objs :: modules - RSame _ iface objs _ -> + RSame _ _ iface objs _ -> Fresh name iface objs :: modules - RCached main _ mvar -> + RCached _ main _ mvar -> Cached name main mvar :: modules RNotFound _ -> @@ -1877,27 +1927,30 @@ dictRawMVarBResultEncoder = bResultEncoder : BResult -> BE.Encoder bResultEncoder bResult = case bResult of - RNew local iface objects docs -> + RNew warnings local iface objects docs -> BE.sequence [ BE.unsignedInt8 0 + , W.moduleEncoder warnings , Details.localEncoder local , I.interfaceEncoder iface , Opt.localGraphEncoder objects , BE.maybe Docs.bytesModuleEncoder docs ] - RSame local iface objects docs -> + RSame warnings local iface objects docs -> BE.sequence [ BE.unsignedInt8 1 + , W.moduleEncoder warnings , Details.localEncoder local , I.interfaceEncoder iface , Opt.localGraphEncoder objects , BE.maybe Docs.bytesModuleEncoder docs ] - RCached main lastChange (MVar ref) -> + RCached warnings main lastChange (MVar ref) -> BE.sequence [ BE.unsignedInt8 2 + , BE.maybe W.moduleEncoder warnings , BE.bool main , BE.int lastChange , BE.int ref @@ -1935,21 +1988,24 @@ bResultDecoder = (\idx -> case idx of 0 -> - BD.map4 RNew + BD.map5 RNew + W.moduleDecoder Details.localDecoder I.interfaceDecoder Opt.localGraphDecoder (BD.maybe Docs.bytesModuleDecoder) 1 -> - BD.map4 RSame + BD.map5 RSame + W.moduleDecoder Details.localDecoder I.interfaceDecoder Opt.localGraphDecoder (BD.maybe Docs.bytesModuleDecoder) 2 -> - BD.map3 RCached + BD.map4 RCached + (BD.maybe W.moduleDecoder) BD.bool BD.int (BD.map MVar BD.int) @@ -2256,9 +2312,10 @@ docsNeedDecoder = artifactsEncoder : Artifacts -> BE.Encoder -artifactsEncoder (Artifacts pkg ifaces roots modules) = +artifactsEncoder (Artifacts warnings pkg ifaces roots modules) = BE.sequence - [ Pkg.nameEncoder pkg + [ BE.list W.moduleEncoder warnings + , Pkg.nameEncoder pkg , dependenciesEncoder ifaces , BE.nonempty rootEncoder roots , BE.list moduleEncoder modules @@ -2267,7 +2324,8 @@ artifactsEncoder (Artifacts pkg ifaces roots modules) = artifactsDecoder : BD.Decoder Artifacts artifactsDecoder = - BD.map4 Artifacts + BD.map5 Artifacts + (BD.list W.moduleDecoder) Pkg.nameDecoder dependenciesDecoder (BD.nonempty rootDecoder) diff --git a/src/Builder/Generate.elm b/src/Builder/Generate.elm index 52f2d5d85..72e3991d0 100644 --- a/src/Builder/Generate.elm +++ b/src/Builder/Generate.elm @@ -38,7 +38,7 @@ import Utils.Task.Extra as Task debug : Bool -> Int -> Stuff.Root -> Details.Details -> Build.Artifacts -> Task Exit.Generate String -debug withSourceMaps leadingLines root details (Build.Artifacts pkg ifaces roots modules) = +debug withSourceMaps leadingLines root details (Build.Artifacts _ pkg ifaces roots modules) = loadObjects (Stuff.rootPath root) details modules |> Task.bind (\loading -> @@ -69,7 +69,7 @@ debug withSourceMaps leadingLines root details (Build.Artifacts pkg ifaces roots dev : Bool -> Int -> Stuff.Root -> Details.Details -> Build.Artifacts -> Task Exit.Generate String -dev withSourceMaps leadingLines root details (Build.Artifacts pkg _ roots modules) = +dev withSourceMaps leadingLines root details (Build.Artifacts _ pkg _ roots modules) = Task.bind finalizeObjects (loadObjects (Stuff.rootPath root) details modules) |> Task.bind (\objects -> @@ -92,7 +92,7 @@ dev withSourceMaps leadingLines root details (Build.Artifacts pkg _ roots module prod : Bool -> Int -> Stuff.Root -> Details.Details -> Build.Artifacts -> Task Exit.Generate String -prod withSourceMaps leadingLines root details (Build.Artifacts pkg _ roots modules) = +prod withSourceMaps leadingLines root details (Build.Artifacts _ pkg _ roots modules) = Task.bind finalizeObjects (loadObjects (Stuff.rootPath root) details modules) |> Task.bind (\objects -> diff --git a/src/Builder/Guida/Details.elm b/src/Builder/Guida/Details.elm index 181c0e9f2..7cd13bf4b 100644 --- a/src/Builder/Guida/Details.elm +++ b/src/Builder/Guida/Details.elm @@ -1158,7 +1158,7 @@ compile target root pkg mvar status = Just results -> Compile.compile target root pkg (Utils.mapMapMaybe identity compare getInterface results) modul |> Task.fmap - (\result -> + (\( _, result ) -> case result of Err _ -> Nothing diff --git a/src/Builder/Reporting.elm b/src/Builder/Reporting.elm index 7d3c835f6..24997783b 100644 --- a/src/Builder/Reporting.elm +++ b/src/Builder/Reporting.elm @@ -462,8 +462,8 @@ toFinalMessage done result = Exit.BuildBadModules _ _ [] -> "Detected problems in 1 module." - Exit.BuildBadModules _ _ (_ :: ps) -> - "Detected problems in " ++ String.fromInt (2 + List.length ps) ++ " modules." + Exit.BuildBadModules _ _ ps -> + "Detected problems in " ++ String.fromInt (1 + List.length ps) ++ " modules." Exit.BuildProjectProblem _ -> "Detected a problem." diff --git a/src/Builder/Stuff.elm b/src/Builder/Stuff.elm index 48e2bb37b..b6f0d09f2 100644 --- a/src/Builder/Stuff.elm +++ b/src/Builder/Stuff.elm @@ -10,6 +10,7 @@ module Builder.Stuff exposing , getReplCache , guidai , guidao + , guidaw , interfaces , isRootGuida , objects @@ -89,6 +90,11 @@ guidai root name = toArtifactPath root name "guidai" +guidaw : String -> ModuleName.Raw -> String +guidaw root name = + toArtifactPath root name "guidaw" + + guidao : String -> ModuleName.Raw -> String guidao root name = toArtifactPath root name "guidao" diff --git a/src/Compiler/Compile.elm b/src/Compiler/Compile.elm index 00dd921e5..f0615d743 100644 --- a/src/Compiler/Compile.elm +++ b/src/Compiler/Compile.elm @@ -18,6 +18,7 @@ import Compiler.Optimize.Module as Optimize import Compiler.Reporting.Error as E import Compiler.Reporting.Render.Type.Localizer as Localizer import Compiler.Reporting.Result as R +import Compiler.Reporting.Warning as W import Compiler.Type.Constrain.Module as Type import Compiler.Type.Solve as Type import Data.Map exposing (Dict) @@ -34,39 +35,48 @@ type Artifacts = Artifacts Can.Module (Dict String Name Can.Annotation) Opt.LocalGraph -compile : Target -> Stuff.Root -> Pkg.Name -> Dict String ModuleName.Raw I.Interface -> Src.Module -> Task Never (Result E.Error Artifacts) +compile : Target -> Stuff.Root -> Pkg.Name -> Dict String ModuleName.Raw I.Interface -> Src.Module -> Task Never ( List W.Warning, Result E.Error Artifacts ) compile target root pkg ifaces modul = - Task.pure (canonicalize target root pkg ifaces modul) - |> Task.fmap - (\canonicalResult -> - case canonicalResult of - Ok canonical -> - Result.map2 (\annotations () -> annotations) - (typeCheck target modul canonical) - (nitpick target canonical) - |> Result.andThen - (\annotations -> - optimize target modul annotations canonical - |> Result.map (\objects -> Artifacts canonical annotations objects) - ) - - Err err -> - Err err - ) + let + ( canonicalWarnings, canonicalResult ) = + canonicalize target root pkg ifaces modul + in + case canonicalResult of + Ok canonical -> + case + Result.map2 (\annotations () -> annotations) + (typeCheck target modul canonical) + (nitpick target canonical) + of + Ok annotations -> + let + ( optWarnings, optResult ) = + optimize target modul annotations canonical + in + Task.pure + ( canonicalWarnings ++ optWarnings + , Result.map (\objects -> Artifacts canonical annotations objects) optResult + ) + + Err err -> + Task.pure ( canonicalWarnings, Err err ) + + Err err -> + Task.pure ( canonicalWarnings, Err err ) -- PHASES -canonicalize : Target -> Stuff.Root -> Pkg.Name -> Dict String ModuleName.Raw I.Interface -> Src.Module -> Result E.Error Can.Module +canonicalize : Target -> Stuff.Root -> Pkg.Name -> Dict String ModuleName.Raw I.Interface -> Src.Module -> ( List W.Warning, Result E.Error Can.Module ) canonicalize target root pkg ifaces modul = - case Tuple.second (R.run (Canonicalize.canonicalize target root pkg ifaces modul)) of - Ok canonical -> - Ok canonical + case R.run (Canonicalize.canonicalize target root pkg ifaces modul) of + ( warnings, Ok canonical ) -> + ( warnings, Ok canonical ) - Err errors -> - Err (E.BadNames errors) + ( warnings, Err errors ) -> + ( warnings, Err (E.BadNames errors) ) typeCheck : Target -> Src.Module -> Can.Module -> Result E.Error (Dict String Name Can.Annotation) @@ -89,11 +99,11 @@ nitpick target canonical = Err (E.BadPatterns errors) -optimize : Target -> Src.Module -> Dict String Name.Name Can.Annotation -> Can.Module -> Result E.Error Opt.LocalGraph +optimize : Target -> Src.Module -> Dict String Name.Name Can.Annotation -> Can.Module -> ( List W.Warning, Result E.Error Opt.LocalGraph ) optimize target ((Src.Module syntaxVersion _ _ _ _ _ _ _ _ _) as modul) annotations canonical = - case Tuple.second (R.run (Optimize.optimize target syntaxVersion annotations canonical)) of - Ok localGraph -> - Ok localGraph + case R.run (Optimize.optimize target syntaxVersion annotations canonical) of + ( warnings, Ok localGraph ) -> + ( warnings, Ok localGraph ) - Err errors -> - Err (E.BadMains (Localizer.fromModule modul) errors) + ( warnings, Err errors ) -> + ( warnings, Err (E.BadMains (Localizer.fromModule modul) errors) ) diff --git a/src/Compiler/Reporting/Error.elm b/src/Compiler/Reporting/Error.elm index f06f411b9..3d33ddeca 100644 --- a/src/Compiler/Reporting/Error.elm +++ b/src/Compiler/Reporting/Error.elm @@ -6,6 +6,7 @@ module Compiler.Reporting.Error exposing , reportToJson , toDoc , toJson + , warningReportToJson ) import Builder.File as File @@ -207,6 +208,15 @@ toJson { name, absolutePath, source, error } = ] +warningReportToJson : Report.WarningModuleReport -> E.Value +warningReportToJson { path, name, warnings } = + E.object + [ ( "path", E.string path ) + , ( "name", E.string name ) + , ( "warnings", E.list reportToJson warnings ) + ] + + reportToJson : Report.Report -> E.Value reportToJson (Report.Report title region _ message) = E.object diff --git a/src/Compiler/Reporting/Report.elm b/src/Compiler/Reporting/Report.elm index 2877fd85b..c87c231f0 100644 --- a/src/Compiler/Reporting/Report.elm +++ b/src/Compiler/Reporting/Report.elm @@ -1,4 +1,7 @@ -module Compiler.Reporting.Report exposing (Report(..)) +module Compiler.Reporting.Report exposing + ( Report(..) + , WarningModuleReport + ) import Compiler.Reporting.Annotation as A import Compiler.Reporting.Doc as D @@ -8,5 +11,12 @@ import Compiler.Reporting.Doc as D -- BUILD REPORTS +type alias WarningModuleReport = + { path : String + , name : String + , warnings : List Report + } + + type Report = Report String A.Region (List String) D.Doc diff --git a/src/Compiler/Reporting/Warning.elm b/src/Compiler/Reporting/Warning.elm index a2553ff69..ab3a56077 100644 --- a/src/Compiler/Reporting/Warning.elm +++ b/src/Compiler/Reporting/Warning.elm @@ -1,19 +1,43 @@ module Compiler.Reporting.Warning exposing ( Context(..) + , Module , Warning(..) + , contextDecoder + , contextEncoder + , moduleDecoder + , moduleEncoder , toReport + , warningDecoder + , warningEncoder ) import Compiler.AST.Canonical as Can import Compiler.AST.Utils.Type as Type import Compiler.Data.Name exposing (Name) import Compiler.Generate.Target exposing (Target) +import Compiler.Guida.ModuleName as ModuleName import Compiler.Reporting.Annotation as A import Compiler.Reporting.Doc as D import Compiler.Reporting.Render.Code as Code import Compiler.Reporting.Render.Type as RT import Compiler.Reporting.Render.Type.Localizer as L import Compiler.Reporting.Report exposing (Report(..)) +import Time +import Utils.Bytes.Decode as BD +import Utils.Bytes.Encode as BE + + + +-- MODULE + + +type alias Module = + { name : ModuleName.Raw + , absolutePath : String + , modificationTime : Time.Posix + , source : String + , warnings : List Warning + } @@ -39,7 +63,7 @@ toReport : Target -> L.Localizer -> Code.Source -> Warning -> Report toReport target localizer source warning = case warning of UnusedImport region moduleName -> - Report "unused import" region [] <| + Report "UNUSED IMPORT" region [] <| Code.toSnippet source region Nothing <| ( D.reflow ("Nothing from the `" ++ moduleName ++ "` module is used in this file.") , D.fromChars "I recommend removing unused imports." @@ -49,7 +73,7 @@ toReport target localizer source warning = let title : String title = - defOrPat context "unused definition" "unused variable" + defOrPat context "UNUSED DEFINITION" "UNUSED VARIABLE" in Report title region [] <| Code.toSnippet source region Nothing <| @@ -70,7 +94,7 @@ toReport target localizer source warning = ) MissingTypeAnnotation region name inferredType -> - Report "missing type annotation" region [] <| + Report "MISSING TYPE ANNOTATION" region [] <| Code.toSnippet source region Nothing <| ( D.reflow <| case Type.deepDealias inferredType of @@ -82,7 +106,7 @@ toReport target localizer source warning = , D.stack [ D.fromChars "I inferred the type annotation myself though! You can copy it into your code:" , D.green <| - D.hang 4 <| + D.indent 4 <| D.sep [ D.fromName name |> D.a (D.fromChars " :") , RT.canToDoc target localizer RT.None inferredType @@ -99,3 +123,110 @@ defOrPat context def pat = Pattern -> pat + + + +-- ENCODERS and DECODERS + + +moduleEncoder : Module -> BE.Encoder +moduleEncoder modul = + BE.sequence + [ ModuleName.rawEncoder modul.name + , BE.string modul.absolutePath + , BE.int (Time.posixToMillis modul.modificationTime) + , BE.string modul.source + , BE.list warningEncoder modul.warnings + ] + + +moduleDecoder : BD.Decoder Module +moduleDecoder = + BD.map5 Module + ModuleName.rawDecoder + BD.string + (BD.map Time.millisToPosix BD.int) + BD.string + (BD.list warningDecoder) + + +warningEncoder : Warning -> BE.Encoder +warningEncoder warning = + case warning of + UnusedImport region name -> + BE.sequence + [ BE.unsignedInt8 0 + , A.regionEncoder region + , BE.string name + ] + + UnusedVariable region context name -> + BE.sequence + [ BE.unsignedInt8 1 + , A.regionEncoder region + , contextEncoder context + , BE.string name + ] + + MissingTypeAnnotation region name tipe -> + BE.sequence + [ BE.unsignedInt8 2 + , A.regionEncoder region + , BE.string name + , Can.typeEncoder tipe + ] + + +warningDecoder : BD.Decoder Warning +warningDecoder = + BD.unsignedInt8 + |> BD.andThen + (\idx -> + case idx of + 0 -> + BD.map2 UnusedImport + A.regionDecoder + BD.string + + 1 -> + BD.map3 UnusedVariable + A.regionDecoder + contextDecoder + BD.string + + 2 -> + BD.map3 MissingTypeAnnotation + A.regionDecoder + BD.string + Can.typeDecoder + + _ -> + BD.fail + ) + + +contextEncoder : Context -> BE.Encoder +contextEncoder context = + case context of + Def -> + BE.unsignedInt8 0 + + Pattern -> + BE.unsignedInt8 1 + + +contextDecoder : BD.Decoder Context +contextDecoder = + BD.unsignedInt8 + |> BD.andThen + (\idx -> + case idx of + 0 -> + BD.succeed Def + + 1 -> + BD.succeed Pattern + + _ -> + BD.fail + ) diff --git a/src/Terminal/Make.elm b/src/Terminal/Make.elm index f13dab38c..10c0fd383 100644 --- a/src/Terminal/Make.elm +++ b/src/Terminal/Make.elm @@ -18,11 +18,18 @@ import Builder.Generate as Generate import Builder.Guida.Details as Details import Builder.Reporting as Reporting import Builder.Reporting.Exit as Exit +import Builder.Reporting.Exit.Help as Help import Builder.Stuff as Stuff import Compiler.AST.Optimized as Opt import Compiler.Data.NonEmptyList as NE import Compiler.Generate.Html as Html +import Compiler.Generate.Target exposing (Target) import Compiler.Guida.ModuleName as ModuleName +import Compiler.Reporting.Doc as D +import Compiler.Reporting.Render.Code as Code +import Compiler.Reporting.Render.Type.Localizer as L +import Compiler.Reporting.Report as Report +import Compiler.Reporting.Warning as W import Maybe.Extra as Maybe import Task exposing (Task) import Terminal.Terminal.Internal exposing (Parser(..)) @@ -94,51 +101,55 @@ runHelp root paths style (Flags debug optimize withSourceMaps maybeOutput _ mayb buildPaths style root details (NE.Nonempty p ps) |> Task.bind (\artifacts -> - case maybeOutput of - Nothing -> - case getMains artifacts of - [] -> - Task.pure () - - [ name ] -> - toBuilder withSourceMaps Html.leadingLines root details desiredMode artifacts - |> Task.bind - (\builder -> - generate style "index.html" (Html.sandwich (Stuff.rootToTarget root) name builder) (NE.Nonempty name []) - ) - - name :: names -> - toBuilder withSourceMaps 0 root details desiredMode artifacts - |> Task.bind - (\builder -> - generate style "guida.js" builder (NE.Nonempty name names) - ) - - Just DevNull -> - Task.pure () - - Just (JS target) -> - case getNoMains artifacts of - [] -> - toBuilder withSourceMaps 0 root details desiredMode artifacts - |> Task.bind - (\builder -> - generate style target builder (Build.getRootNames artifacts) - ) - - name :: names -> - Task.throw (Exit.MakeNonMainFilesIntoJavaScript name names) - - Just (Html target) -> - hasOneMain artifacts - |> Task.bind - (\name -> - toBuilder withSourceMaps Html.leadingLines root details desiredMode artifacts + Task.io (reportWarnings root artifacts) + |> Task.bind + (\_ -> + case maybeOutput of + Nothing -> + case getMains artifacts of + [] -> + Task.pure () + + [ name ] -> + toBuilder withSourceMaps Html.leadingLines root details desiredMode artifacts + |> Task.bind + (\builder -> + generate style "index.html" (Html.sandwich (Stuff.rootToTarget root) name builder) (NE.Nonempty name []) + ) + + name :: names -> + toBuilder withSourceMaps 0 root details desiredMode artifacts + |> Task.bind + (\builder -> + generate style "guida.js" builder (NE.Nonempty name names) + ) + + Just DevNull -> + Task.pure () + + Just (JS target) -> + case getNoMains artifacts of + [] -> + toBuilder withSourceMaps 0 root details desiredMode artifacts + |> Task.bind + (\builder -> + generate style target builder (Build.getRootNames artifacts) + ) + + name :: names -> + Task.throw (Exit.MakeNonMainFilesIntoJavaScript name names) + + Just (Html target) -> + hasOneMain artifacts |> Task.bind - (\builder -> - generate style target (Html.sandwich (Stuff.rootToTarget root) name builder) (NE.Nonempty name []) + (\name -> + toBuilder withSourceMaps Html.leadingLines root details desiredMode artifacts + |> Task.bind + (\builder -> + generate style target (Html.sandwich (Stuff.rootToTarget root) name builder) (NE.Nonempty name []) + ) ) - ) + ) ) ) ) @@ -230,7 +241,7 @@ buildPaths style root details paths = getMains : Build.Artifacts -> List ModuleName.Raw -getMains (Build.Artifacts _ _ roots modules) = +getMains (Build.Artifacts _ _ _ roots modules) = List.filterMap (getMain modules) (NE.toList roots) @@ -264,7 +275,7 @@ isMain targetName modul = hasOneMain : Build.Artifacts -> Task Exit.Make ModuleName.Raw -hasOneMain (Build.Artifacts _ _ roots modules) = +hasOneMain (Build.Artifacts _ _ _ roots modules) = case roots of NE.Nonempty root [] -> Task.mio Exit.MakeNoMain (Task.pure <| getMain modules root) @@ -278,7 +289,7 @@ hasOneMain (Build.Artifacts _ _ roots modules) = getNoMains : Build.Artifacts -> List ModuleName.Raw -getNoMains (Build.Artifacts _ _ roots modules) = +getNoMains (Build.Artifacts _ _ _ roots modules) = List.filterMap (getNoMain modules) (NE.toList roots) @@ -302,6 +313,70 @@ getNoMain modules root = +-- WARNINGS + + +reportWarnings : Stuff.Root -> Build.Artifacts -> Task Never () +reportWarnings root (Build.Artifacts warnings _ _ _ _) = + if List.isEmpty warnings then + Task.pure () + + else + let + rootPath : FilePath + rootPath = + Stuff.rootPath root + + target : Target + target = + Stuff.rootToTarget root + in + Utils.listTraverse (warningToDoc target rootPath) warnings + |> Task.bind (\docs -> Help.toStderr (D.vcat (docs ++ [ D.fromChars "" ]))) + + +warningToDoc : Target -> FilePath -> W.Module -> Task Never D.Doc +warningToDoc target rootPath { absolutePath, warnings } = + File.readUtf8 absolutePath + |> Task.fmap + (\sourceCode -> + let + reports : List Report.Report + reports = + List.map (W.toReport target L.empty (Code.toSource sourceCode)) warnings + in + D.vcat (List.map (reportToDoc rootPath absolutePath) reports) + ) + + +reportToDoc : FilePath -> FilePath -> Report.Report -> D.Doc +reportToDoc rootPath absolutePath (Report.Report title _ _ message) = + D.vcat + [ toMessageBar title (Utils.fpMakeRelative rootPath absolutePath) + , D.fromChars "" + , message + , D.fromChars "" + ] + + +toMessageBar : String -> String -> D.Doc +toMessageBar title filePath = + let + usedSpace : Int + usedSpace = + 4 + String.length title + 1 + String.length filePath + in + D.yellow <| + D.fromChars <| + "-- " + ++ title + ++ " " + ++ String.repeat (max 1 (80 - usedSpace)) "-" + ++ " " + ++ filePath + + + -- GENERATE diff --git a/tests/api.test.js b/tests/api.test.js index 9e4c82342..5a961e7dc 100644 --- a/tests/api.test.js +++ b/tests/api.test.js @@ -90,6 +90,30 @@ suite = `); }); + it("make - reports warnings", async () => { + const tmpobj = tmp.dirSync(); + process.chdir(tmpobj.name); + + await guida.init(config(), { package: false }); + + fs.writeFileSync(path.join(tmpobj.name, "src", "Main.guida"), `module Main exposing (main) + +main : Program () () () +main = + Platform.worker + { init = \\_ -> ( (), Cmd.none ) + , update = \\_ model -> ( model, Cmd.none ) + , subscriptions = \\_ -> Sub.none + } + +noTypeAnnotationFn unusedVar = 1 +`); + + const result = await guida.make(config(), path.join(tmpobj.name, "src", "Main.guida")); + expect(result).toHaveProperty("output", expect.any(String)); + expect(result).toHaveProperty("warnings", expect.any(Array)); + }); + it.skip("getDefinitionLocation - simple example", async () => { const tmpobj = tmp.dirSync(); process.chdir(tmpobj.name); From c829cdf7cd8901e7021185d24c8b19d60d0ecf53 Mon Sep 17 00:00:00 2001 From: Decio Ferreira Date: Sun, 8 Mar 2026 22:45:07 +0000 Subject: [PATCH 02/11] feat: add deny-warnings flag to treat warnings as errors in the compiler --- src/API/Main.elm | 4 +- src/API/Make.elm | 12 ++-- src/Builder/Build.elm | 8 +-- src/Builder/Reporting.elm | 63 +++++++++++++------ src/Terminal/Main.elm | 2 + src/Terminal/Make.elm | 125 +++++++++++++++++++++----------------- src/Terminal/Test.elm | 2 +- 7 files changed, 129 insertions(+), 87 deletions(-) diff --git a/src/API/Main.elm b/src/API/Main.elm index 127a17b0c..5784a0eea 100644 --- a/src/API/Main.elm +++ b/src/API/Main.elm @@ -48,7 +48,7 @@ app = ) MakeArgs path debug optimize withSourceMaps -> - Make.run path (Make.Flags debug optimize withSourceMaps) + Make.run path (Make.Flags debug optimize withSourceMaps False) |> Task.bind (\result -> case result of @@ -123,7 +123,7 @@ app = ) DiagnosticsArgs (DiagnosticsSourcePath path) -> - Make.run path (Make.Flags False False False) + Make.run path (Make.Flags False False False False) |> Task.bind (\result -> case result of diff --git a/src/API/Make.elm b/src/API/Make.elm index edd70b63c..68a7aa9f8 100644 --- a/src/API/Make.elm +++ b/src/API/Make.elm @@ -41,7 +41,7 @@ import Utils.Task.Extra as Task type Flags - = Flags Bool Bool Bool + = Flags Bool Bool Bool Bool type Output @@ -73,7 +73,7 @@ run path flags = runHelp : Stuff.Root -> String -> Flags -> Task Never (Result Exit.Make ( String, List Report.WarningModuleReport )) -runHelp root path (Flags debug optimize withSourceMaps) = +runHelp root path (Flags debug optimize withSourceMaps denyWarnings) = BW.withScope (\scope -> Stuff.withRootLock (Stuff.rootPath root) <| @@ -89,7 +89,7 @@ runHelp root path (Flags debug optimize withSourceMaps) = Task.eio Exit.MakeBadDetails (Details.load style scope root) |> Task.bind (\details -> - buildPaths style root details (NE.Nonempty path []) + buildPaths style root details denyWarnings (NE.Nonempty path []) |> Task.bind (\((Build.Artifacts warnings _ _ _ _) as artifacts) -> case getMains artifacts of @@ -149,10 +149,10 @@ getMode debug optimize = -- BUILD PROJECTS -buildPaths : Reporting.Style -> Stuff.Root -> Details.Details -> NE.Nonempty FilePath -> Task Exit.Make Build.Artifacts -buildPaths style root details paths = +buildPaths : Reporting.Style -> Stuff.Root -> Details.Details -> Bool -> NE.Nonempty FilePath -> Task Exit.Make Build.Artifacts +buildPaths style root details denyWarnings paths = Task.eio Exit.MakeCannotBuild <| - Build.fromPaths style root details paths + Build.fromPaths style root details denyWarnings paths diff --git a/src/Builder/Build.elm b/src/Builder/Build.elm index dbb9c68bd..edc8e7e57 100644 --- a/src/Builder/Build.elm +++ b/src/Builder/Build.elm @@ -135,7 +135,7 @@ forkWithKey toComparable keyComparison encoder func dict = fromExposed : BD.Decoder docs -> (docs -> BE.Encoder) -> Reporting.Style -> Stuff.Root -> Details.Details -> DocsGoal docs -> NE.Nonempty ModuleName.Raw -> Task Never (Result Exit.BuildProblem docs) fromExposed docsDecoder docsEncoder style root details docsGoal ((NE.Nonempty e es) as exposed) = - Reporting.trackBuild docsDecoder docsEncoder style <| + Reporting.trackBuild docsDecoder docsEncoder style (\_ -> ( 0, False )) <| \key -> makeEnv key root details |> Task.bind @@ -221,9 +221,9 @@ type alias Dependencies = Dict (List String) TypeCheck.Canonical I.DependencyInterface -fromPaths : Reporting.Style -> Stuff.Root -> Details.Details -> NE.Nonempty FilePath -> Task Never (Result Exit.BuildProblem Artifacts) -fromPaths style root details paths = - Reporting.trackBuild artifactsDecoder artifactsEncoder style <| +fromPaths : Reporting.Style -> Stuff.Root -> Details.Details -> Bool -> NE.Nonempty FilePath -> Task Never (Result Exit.BuildProblem Artifacts) +fromPaths style root details denyWarnings paths = + Reporting.trackBuild artifactsDecoder artifactsEncoder style (\(Artifacts warnings _ _ _ _) -> ( List.length warnings, denyWarnings )) <| \key -> makeEnv key root details |> Task.bind diff --git a/src/Builder/Reporting.elm b/src/Builder/Reporting.elm index 24997783b..967872ed9 100644 --- a/src/Builder/Reporting.elm +++ b/src/Builder/Reporting.elm @@ -370,8 +370,8 @@ type alias BResult a = Result Exit.BuildProblem a -trackBuild : BD.Decoder a -> (a -> BE.Encoder) -> Style -> (BKey -> Task Never (BResult a)) -> Task Never (BResult a) -trackBuild decoder encoder style callback = +trackBuild : BD.Decoder a -> (a -> BE.Encoder) -> Style -> (a -> ( Int, Bool )) -> (BKey -> Task Never (BResult a)) -> Task Never (BResult a) +trackBuild decoder encoder style extractWarningInfo callback = case style of Silent -> callback (Key (\_ -> Task.pure ())) @@ -391,7 +391,7 @@ trackBuild decoder encoder style callback = Utils.forkIO (Utils.takeMVar (BD.succeed ()) mvar |> Task.bind (\_ -> putStrFlush "Compiling ...") - |> Task.bind (\_ -> buildLoop decoder chan 0) + |> Task.bind (\_ -> buildLoop decoder chan 0 extractWarningInfo) |> Task.bind (\_ -> Utils.putMVar (\_ -> BE.bool True) mvar ()) ) |> Task.bind (\_ -> callback (Key (Utils.writeChan chanEncoder chan << Err))) @@ -407,8 +407,8 @@ type BMsg = BDone -buildLoop : BD.Decoder a -> Chan (Result BMsg (BResult a)) -> Int -> Task Never () -buildLoop decoder chan done = +buildLoop : BD.Decoder a -> Chan (Result BMsg (BResult a)) -> Int -> (a -> ( Int, Bool )) -> Task Never () +buildLoop decoder chan done extractWarningInfo = Utils.readChan (BD.result bMsgDecoder (bResultDecoder decoder)) chan |> Task.bind (\msg -> @@ -420,13 +420,13 @@ buildLoop decoder chan done = done + 1 in putStrFlush ("\u{000D}Compiling (" ++ String.fromInt done1 ++ ")") - |> Task.bind (\_ -> buildLoop decoder chan done1) + |> Task.bind (\_ -> buildLoop decoder chan done1 extractWarningInfo) Ok result -> let message : String message = - toFinalMessage done result + toFinalMessage done extractWarningInfo result width : Int width = @@ -443,19 +443,48 @@ buildLoop decoder chan done = ) -toFinalMessage : Int -> BResult a -> String -toFinalMessage done result = +toFinalMessage : Int -> (a -> ( Int, Bool )) -> BResult a -> String +toFinalMessage done extractWarningInfo result = case result of - Ok _ -> - case done of - 0 -> - "Success!" + Ok value -> + let + ( warningCount, denyWarnings ) = + extractWarningInfo value + in + if denyWarnings && warningCount > 0 then + let + warningWord : String + warningWord = + if warningCount == 1 then + "warning" + + else + "warnings" + in + "Failed! " ++ String.fromInt warningCount ++ " " ++ warningWord ++ " with --deny-warnings enabled." + + else + let + warningNote : String + warningNote = + if warningCount == 0 then + "" + + else if warningCount == 1 then + " (1 warning)" + + else + " (" ++ String.fromInt warningCount ++ " warnings)" + in + case done of + 0 -> + "Success!" ++ warningNote - 1 -> - "Success! Compiled 1 module." + 1 -> + "Success! Compiled 1 module." ++ warningNote - n -> - "Success! Compiled " ++ String.fromInt n ++ " modules." + n -> + "Success! Compiled " ++ String.fromInt n ++ " modules." ++ warningNote Err problem -> case problem of diff --git a/src/Terminal/Main.elm b/src/Terminal/Main.elm index ba2d2be73..9db7768d9 100644 --- a/src/Terminal/Main.elm +++ b/src/Terminal/Main.elm @@ -210,6 +210,7 @@ make = |> Terminal.more (Terminal.onOff "debug" "Turn on the time-travelling debugger. It allows you to rewind and replay events. The events can be imported/exported into a file, which makes for very precise bug reports!") |> Terminal.more (Terminal.onOff "optimize" "Turn on optimizations to make code smaller and faster. For example, the compiler renames record fields to be as short as possible and unboxes values to reduce allocation.") |> Terminal.more (Terminal.onOff "sourcemaps" "Add source maps to resulting JavaScript code.") + |> Terminal.more (Terminal.onOff "deny-warnings" "Treat warnings as errors. If set, the build will fail if there are any warnings.") |> Terminal.more (Terminal.flag "output" Make.output "Specify the name of the resulting JS file. For example --output=assets/guida.js to generate the JS at assets/guida.js or --output=/dev/null to generate no output at all!") |> Terminal.more (Terminal.flag "report" Make.reportType "You can say --report=json to get error messages as JSON. This is only really useful if you are an editor plugin. Humans should avoid it!") |> Terminal.more (Terminal.flag "docs" Make.docsFile "Generate a JSON file of documentation for a package. Eventually it will be possible to preview docs with `reactor` because it is quite hard to deal with these JSON files directly.") @@ -224,6 +225,7 @@ make = |> Chomp.apply (Chomp.chompOnOffFlag "debug") |> Chomp.apply (Chomp.chompOnOffFlag "optimize") |> Chomp.apply (Chomp.chompOnOffFlag "sourcemaps") + |> Chomp.apply (Chomp.chompOnOffFlag "deny-warnings") |> Chomp.apply (Chomp.chompNormalFlag "output" Make.output Make.parseOutput) |> Chomp.apply (Chomp.chompNormalFlag "report" Make.reportType Make.parseReportType) |> Chomp.apply (Chomp.chompNormalFlag "docs" Make.docsFile Make.parseDocsFile) diff --git a/src/Terminal/Make.elm b/src/Terminal/Make.elm index 10c0fd383..baccae70d 100644 --- a/src/Terminal/Make.elm +++ b/src/Terminal/Make.elm @@ -31,6 +31,7 @@ import Compiler.Reporting.Render.Type.Localizer as L import Compiler.Reporting.Report as Report import Compiler.Reporting.Warning as W import Maybe.Extra as Maybe +import System.Exit as Exit import Task exposing (Task) import Terminal.Terminal.Internal exposing (Parser(..)) import Utils.Bytes.Decode as BD @@ -44,7 +45,7 @@ import Utils.Task.Extra as Task type Flags - = Flags Bool Bool Bool (Maybe Output) (Maybe ReportType) (Maybe String) + = Flags Bool Bool Bool Bool (Maybe Output) (Maybe ReportType) (Maybe String) type Output @@ -62,7 +63,7 @@ type ReportType run : List String -> Flags -> Task Never () -run paths ((Flags _ _ _ _ report _) as flags) = +run paths ((Flags _ _ _ _ _ report _) as flags) = getStyle report |> Task.bind (\style -> @@ -81,7 +82,7 @@ run paths ((Flags _ _ _ _ report _) as flags) = runHelp : Stuff.Root -> List String -> Reporting.Style -> Flags -> Task Never (Result Exit.Make ()) -runHelp root paths style (Flags debug optimize withSourceMaps maybeOutput _ maybeDocs) = +runHelp root paths style (Flags debug optimize withSourceMaps denyWarnings maybeOutput _ maybeDocs) = BW.withScope (\scope -> Stuff.withRootLock (Stuff.rootPath root) <| @@ -98,58 +99,56 @@ runHelp root paths style (Flags debug optimize withSourceMaps maybeOutput _ mayb |> Task.bind (\exposed -> buildExposed style root details maybeDocs exposed) p :: ps -> - buildPaths style root details (NE.Nonempty p ps) + buildPaths style root details denyWarnings (NE.Nonempty p ps) |> Task.bind (\artifacts -> - Task.io (reportWarnings root artifacts) - |> Task.bind - (\_ -> - case maybeOutput of - Nothing -> - case getMains artifacts of - [] -> - Task.pure () - - [ name ] -> - toBuilder withSourceMaps Html.leadingLines root details desiredMode artifacts - |> Task.bind - (\builder -> - generate style "index.html" (Html.sandwich (Stuff.rootToTarget root) name builder) (NE.Nonempty name []) - ) - - name :: names -> - toBuilder withSourceMaps 0 root details desiredMode artifacts - |> Task.bind - (\builder -> - generate style "guida.js" builder (NE.Nonempty name names) - ) - - Just DevNull -> - Task.pure () - - Just (JS target) -> - case getNoMains artifacts of - [] -> - toBuilder withSourceMaps 0 root details desiredMode artifacts - |> Task.bind - (\builder -> - generate style target builder (Build.getRootNames artifacts) - ) - - name :: names -> - Task.throw (Exit.MakeNonMainFilesIntoJavaScript name names) - - Just (Html target) -> - hasOneMain artifacts + (case maybeOutput of + Nothing -> + case getMains artifacts of + [] -> + Task.pure () + + [ name ] -> + toBuilder withSourceMaps Html.leadingLines root details desiredMode artifacts + |> Task.bind + (\builder -> + generate style "index.html" (Html.sandwich (Stuff.rootToTarget root) name builder) (NE.Nonempty name []) + ) + + name :: names -> + toBuilder withSourceMaps 0 root details desiredMode artifacts + |> Task.bind + (\builder -> + generate style "guida.js" builder (NE.Nonempty name names) + ) + + Just DevNull -> + Task.pure () + + Just (JS target) -> + case getNoMains artifacts of + [] -> + toBuilder withSourceMaps 0 root details desiredMode artifacts + |> Task.bind + (\builder -> + generate style target builder (Build.getRootNames artifacts) + ) + + name :: names -> + Task.throw (Exit.MakeNonMainFilesIntoJavaScript name names) + + Just (Html target) -> + hasOneMain artifacts + |> Task.bind + (\name -> + toBuilder withSourceMaps Html.leadingLines root details desiredMode artifacts |> Task.bind - (\name -> - toBuilder withSourceMaps Html.leadingLines root details desiredMode artifacts - |> Task.bind - (\builder -> - generate style target (Html.sandwich (Stuff.rootToTarget root) name builder) (NE.Nonempty name []) - ) + (\builder -> + generate style target (Html.sandwich (Stuff.rootToTarget root) name builder) (NE.Nonempty name []) ) - ) + ) + ) + |> Task.bind (\_ -> Task.io (reportWarnings denyWarnings root artifacts)) ) ) ) @@ -230,10 +229,10 @@ buildExposed style root details maybeDocs exposed = exposed -buildPaths : Reporting.Style -> Stuff.Root -> Details.Details -> NE.Nonempty FilePath -> Task Exit.Make Build.Artifacts -buildPaths style root details paths = +buildPaths : Reporting.Style -> Stuff.Root -> Details.Details -> Bool -> NE.Nonempty FilePath -> Task Exit.Make Build.Artifacts +buildPaths style root details denyWarnings paths = Task.eio Exit.MakeCannotBuild <| - Build.fromPaths style root details paths + Build.fromPaths style root details denyWarnings paths @@ -316,8 +315,8 @@ getNoMain modules root = -- WARNINGS -reportWarnings : Stuff.Root -> Build.Artifacts -> Task Never () -reportWarnings root (Build.Artifacts warnings _ _ _ _) = +reportWarnings : Bool -> Stuff.Root -> Build.Artifacts -> Task Never () +reportWarnings denyWarnings root (Build.Artifacts warnings _ _ _ _) = if List.isEmpty warnings then Task.pure () @@ -332,7 +331,19 @@ reportWarnings root (Build.Artifacts warnings _ _ _ _) = Stuff.rootToTarget root in Utils.listTraverse (warningToDoc target rootPath) warnings - |> Task.bind (\docs -> Help.toStderr (D.vcat (docs ++ [ D.fromChars "" ]))) + |> Task.mapError never + |> Task.bind + (\docs -> + Task.io (Help.toStderr (D.vcat (docs ++ [ D.fromChars "" ]))) + |> Task.bind + (\_ -> + if denyWarnings then + Exit.exitFailure + + else + Task.pure () + ) + ) warningToDoc : Target -> FilePath -> W.Module -> Task Never D.Doc diff --git a/src/Terminal/Test.elm b/src/Terminal/Test.elm index 15c9aa2fa..90ef14138 100644 --- a/src/Terminal/Test.elm +++ b/src/Terminal/Test.elm @@ -1268,7 +1268,7 @@ runMake root path = buildPaths : Stuff.Root -> Details.Details -> NE.Nonempty FilePath -> Task Exit.Test Build.Artifacts buildPaths root details paths = Task.eio Exit.TestCannotBuild <| - Build.fromPaths Reporting.silent root details paths + Build.fromPaths Reporting.silent root details False paths From bdce9e3383e5e125920bfee4510c4de491360501 Mon Sep 17 00:00:00 2001 From: Decio Ferreira Date: Mon, 9 Mar 2026 18:48:17 +0000 Subject: [PATCH 03/11] feat: refine warning handling by introducing no-warnings flag and updating related logic --- src/API/Main.elm | 4 +- src/API/Make.elm | 6 +- src/Builder/Reporting/Exit.elm | 22 ++++ src/Terminal/Main.elm | 2 + src/Terminal/Make.elm | 218 +++++++++++++++++++-------------- 5 files changed, 158 insertions(+), 94 deletions(-) diff --git a/src/API/Main.elm b/src/API/Main.elm index 5784a0eea..127a17b0c 100644 --- a/src/API/Main.elm +++ b/src/API/Main.elm @@ -48,7 +48,7 @@ app = ) MakeArgs path debug optimize withSourceMaps -> - Make.run path (Make.Flags debug optimize withSourceMaps False) + Make.run path (Make.Flags debug optimize withSourceMaps) |> Task.bind (\result -> case result of @@ -123,7 +123,7 @@ app = ) DiagnosticsArgs (DiagnosticsSourcePath path) -> - Make.run path (Make.Flags False False False False) + Make.run path (Make.Flags False False False) |> Task.bind (\result -> case result of diff --git a/src/API/Make.elm b/src/API/Make.elm index 68a7aa9f8..cc4c11057 100644 --- a/src/API/Make.elm +++ b/src/API/Make.elm @@ -41,7 +41,7 @@ import Utils.Task.Extra as Task type Flags - = Flags Bool Bool Bool Bool + = Flags Bool Bool Bool type Output @@ -73,7 +73,7 @@ run path flags = runHelp : Stuff.Root -> String -> Flags -> Task Never (Result Exit.Make ( String, List Report.WarningModuleReport )) -runHelp root path (Flags debug optimize withSourceMaps denyWarnings) = +runHelp root path (Flags debug optimize withSourceMaps) = BW.withScope (\scope -> Stuff.withRootLock (Stuff.rootPath root) <| @@ -89,7 +89,7 @@ runHelp root path (Flags debug optimize withSourceMaps denyWarnings) = Task.eio Exit.MakeBadDetails (Details.load style scope root) |> Task.bind (\details -> - buildPaths style root details denyWarnings (NE.Nonempty path []) + buildPaths style root details False (NE.Nonempty path []) |> Task.bind (\((Build.Artifacts warnings _ _ _ _) as artifacts) -> case getMains artifacts of diff --git a/src/Builder/Reporting/Exit.elm b/src/Builder/Reporting/Exit.elm index 3deda6f58..670071c23 100644 --- a/src/Builder/Reporting/Exit.elm +++ b/src/Builder/Reporting/Exit.elm @@ -3505,6 +3505,7 @@ toRedirectDoc response = type Make = MakeNoOutline | MakeCannotOptimizeAndDebug + | MakeCannotSuppressAndDenyWarnings | MakeBadDetails Details | MakeAppNeedsFileNames | MakeGuidaPkgNeedsExposing @@ -3548,6 +3549,27 @@ makeToReport make = "I need to take away information to optimize things, and I need to add information to add the debugger. It is impossible to do both at once though! Pick just one of those flags and it should work!" ] + MakeCannotSuppressAndDenyWarnings -> + Help.docReport "CLASHING FLAGS" + Nothing + (D.fillSep + [ D.fromChars "I" + , D.fromChars "cannot" + , D.fromChars "compile" + , D.fromChars "with" + , D.red (D.fromChars "--no-warnings") + , D.fromChars "and" + , D.red (D.fromChars "--deny-warnings") + , D.fromChars "at" + , D.fromChars "the" + , D.fromChars "same" + , D.fromChars "time." + ] + ) + [ D.reflow + "The --no-warnings flag suppresses all warnings, while --deny-warnings treats them as errors. These are contradictory! Pick just one of those flags and it should work!" + ] + MakeBadDetails detailsProblem -> toDetailsReport detailsProblem diff --git a/src/Terminal/Main.elm b/src/Terminal/Main.elm index 9db7768d9..146c73e87 100644 --- a/src/Terminal/Main.elm +++ b/src/Terminal/Main.elm @@ -210,6 +210,7 @@ make = |> Terminal.more (Terminal.onOff "debug" "Turn on the time-travelling debugger. It allows you to rewind and replay events. The events can be imported/exported into a file, which makes for very precise bug reports!") |> Terminal.more (Terminal.onOff "optimize" "Turn on optimizations to make code smaller and faster. For example, the compiler renames record fields to be as short as possible and unboxes values to reduce allocation.") |> Terminal.more (Terminal.onOff "sourcemaps" "Add source maps to resulting JavaScript code.") + |> Terminal.more (Terminal.onOff "no-warnings" "Suppress all warnings.") |> Terminal.more (Terminal.onOff "deny-warnings" "Treat warnings as errors. If set, the build will fail if there are any warnings.") |> Terminal.more (Terminal.flag "output" Make.output "Specify the name of the resulting JS file. For example --output=assets/guida.js to generate the JS at assets/guida.js or --output=/dev/null to generate no output at all!") |> Terminal.more (Terminal.flag "report" Make.reportType "You can say --report=json to get error messages as JSON. This is only really useful if you are an editor plugin. Humans should avoid it!") @@ -225,6 +226,7 @@ make = |> Chomp.apply (Chomp.chompOnOffFlag "debug") |> Chomp.apply (Chomp.chompOnOffFlag "optimize") |> Chomp.apply (Chomp.chompOnOffFlag "sourcemaps") + |> Chomp.apply (Chomp.chompOnOffFlag "no-warnings") |> Chomp.apply (Chomp.chompOnOffFlag "deny-warnings") |> Chomp.apply (Chomp.chompNormalFlag "output" Make.output Make.parseOutput) |> Chomp.apply (Chomp.chompNormalFlag "report" Make.reportType Make.parseReportType) diff --git a/src/Terminal/Make.elm b/src/Terminal/Make.elm index baccae70d..54abbda33 100644 --- a/src/Terminal/Make.elm +++ b/src/Terminal/Make.elm @@ -44,8 +44,13 @@ import Utils.Task.Extra as Task -- FLAGS +type Warnings + = NoWarnings + | Warnings Bool + + type Flags - = Flags Bool Bool Bool Bool (Maybe Output) (Maybe ReportType) (Maybe String) + = Flags Bool Bool Bool Bool Bool (Maybe Output) (Maybe ReportType) (Maybe String) type Output @@ -63,7 +68,7 @@ type ReportType run : List String -> Flags -> Task Never () -run paths ((Flags _ _ _ _ _ report _) as flags) = +run paths ((Flags _ _ _ _ _ _ report _) as flags) = getStyle report |> Task.bind (\style -> @@ -82,7 +87,7 @@ run paths ((Flags _ _ _ _ _ report _) as flags) = runHelp : Stuff.Root -> List String -> Reporting.Style -> Flags -> Task Never (Result Exit.Make ()) -runHelp root paths style (Flags debug optimize withSourceMaps denyWarnings maybeOutput _ maybeDocs) = +runHelp root paths style (Flags debug optimize withSourceMaps noWarnings denyWarnings maybeOutput _ maybeDocs) = BW.withScope (\scope -> Stuff.withRootLock (Stuff.rootPath root) <| @@ -90,66 +95,70 @@ runHelp root paths style (Flags debug optimize withSourceMaps denyWarnings maybe (getMode debug optimize |> Task.bind (\desiredMode -> - Task.eio Exit.MakeBadDetails (Details.load style scope root) + getWarnings noWarnings denyWarnings |> Task.bind - (\details -> - case paths of - [] -> - getExposed root details - |> Task.bind (\exposed -> buildExposed style root details maybeDocs exposed) - - p :: ps -> - buildPaths style root details denyWarnings (NE.Nonempty p ps) - |> Task.bind - (\artifacts -> - (case maybeOutput of - Nothing -> - case getMains artifacts of - [] -> - Task.pure () - - [ name ] -> - toBuilder withSourceMaps Html.leadingLines root details desiredMode artifacts - |> Task.bind - (\builder -> - generate style "index.html" (Html.sandwich (Stuff.rootToTarget root) name builder) (NE.Nonempty name []) - ) - - name :: names -> - toBuilder withSourceMaps 0 root details desiredMode artifacts - |> Task.bind - (\builder -> - generate style "guida.js" builder (NE.Nonempty name names) - ) - - Just DevNull -> - Task.pure () - - Just (JS target) -> - case getNoMains artifacts of - [] -> - toBuilder withSourceMaps 0 root details desiredMode artifacts - |> Task.bind - (\builder -> - generate style target builder (Build.getRootNames artifacts) - ) - - name :: names -> - Task.throw (Exit.MakeNonMainFilesIntoJavaScript name names) - - Just (Html target) -> - hasOneMain artifacts - |> Task.bind - (\name -> - toBuilder withSourceMaps Html.leadingLines root details desiredMode artifacts + (\warnings -> + Task.eio Exit.MakeBadDetails (Details.load style scope root) + |> Task.bind + (\details -> + case paths of + [] -> + getExposed root details + |> Task.bind (\exposed -> buildExposed style root details maybeDocs exposed) + + p :: ps -> + buildPaths style root details warnings (NE.Nonempty p ps) + |> Task.bind + (\artifacts -> + (case maybeOutput of + Nothing -> + case getMains artifacts of + [] -> + Task.pure () + + [ name ] -> + toBuilder withSourceMaps Html.leadingLines root details desiredMode artifacts + |> Task.bind + (\builder -> + generate style "index.html" (Html.sandwich (Stuff.rootToTarget root) name builder) (NE.Nonempty name []) + ) + + name :: names -> + toBuilder withSourceMaps 0 root details desiredMode artifacts + |> Task.bind + (\builder -> + generate style "guida.js" builder (NE.Nonempty name names) + ) + + Just DevNull -> + Task.pure () + + Just (JS target) -> + case getNoMains artifacts of + [] -> + toBuilder withSourceMaps 0 root details desiredMode artifacts + |> Task.bind + (\builder -> + generate style target builder (Build.getRootNames artifacts) + ) + + name :: names -> + Task.throw (Exit.MakeNonMainFilesIntoJavaScript name names) + + Just (Html target) -> + hasOneMain artifacts |> Task.bind - (\builder -> - generate style target (Html.sandwich (Stuff.rootToTarget root) name builder) (NE.Nonempty name []) + (\name -> + toBuilder withSourceMaps Html.leadingLines root details desiredMode artifacts + |> Task.bind + (\builder -> + generate style target (Html.sandwich (Stuff.rootToTarget root) name builder) (NE.Nonempty name []) + ) ) - ) - ) - |> Task.bind (\_ -> Task.io (reportWarnings denyWarnings root artifacts)) - ) + ) + |> Task.bind (\_ -> Task.io (reportWarnings warnings root artifacts)) + ) + ) ) ) ) @@ -186,6 +195,22 @@ getMode debug optimize = Task.pure Prod +getWarnings : Bool -> Bool -> Task Exit.Make Warnings +getWarnings noWarnings denyWarnings = + case ( noWarnings, denyWarnings ) of + ( True, True ) -> + Task.throw Exit.MakeCannotSuppressAndDenyWarnings + + ( True, False ) -> + Task.pure NoWarnings + + ( False, False ) -> + Task.pure (Warnings False) + + ( False, True ) -> + Task.pure (Warnings True) + + getExposed : Stuff.Root -> Details.Details -> Task Exit.Make (NE.Nonempty ModuleName.Raw) getExposed root (Details.Details _ validOutline _ _ _ _) = case validOutline of @@ -229,8 +254,18 @@ buildExposed style root details maybeDocs exposed = exposed -buildPaths : Reporting.Style -> Stuff.Root -> Details.Details -> Bool -> NE.Nonempty FilePath -> Task Exit.Make Build.Artifacts -buildPaths style root details denyWarnings paths = +buildPaths : Reporting.Style -> Stuff.Root -> Details.Details -> Warnings -> NE.Nonempty FilePath -> Task Exit.Make Build.Artifacts +buildPaths style root details warnings paths = + let + denyWarnings : Bool + denyWarnings = + case warnings of + NoWarnings -> + False + + Warnings deny -> + deny + in Task.eio Exit.MakeCannotBuild <| Build.fromPaths style root details denyWarnings paths @@ -315,35 +350,40 @@ getNoMain modules root = -- WARNINGS -reportWarnings : Bool -> Stuff.Root -> Build.Artifacts -> Task Never () -reportWarnings denyWarnings root (Build.Artifacts warnings _ _ _ _) = - if List.isEmpty warnings then - Task.pure () +reportWarnings : Warnings -> Stuff.Root -> Build.Artifacts -> Task Never () +reportWarnings warnings root (Build.Artifacts warnList _ _ _ _) = + case warnings of + NoWarnings -> + Task.pure () - else - let - rootPath : FilePath - rootPath = - Stuff.rootPath root - - target : Target - target = - Stuff.rootToTarget root - in - Utils.listTraverse (warningToDoc target rootPath) warnings - |> Task.mapError never - |> Task.bind - (\docs -> - Task.io (Help.toStderr (D.vcat (docs ++ [ D.fromChars "" ]))) - |> Task.bind - (\_ -> - if denyWarnings then - Exit.exitFailure + Warnings denyWarnings -> + if List.isEmpty warnList then + Task.pure () - else - Task.pure () - ) - ) + else + let + rootPath : FilePath + rootPath = + Stuff.rootPath root + + target : Target + target = + Stuff.rootToTarget root + in + Utils.listTraverse (warningToDoc target rootPath) warnList + |> Task.mapError never + |> Task.bind + (\docs -> + Task.io (Help.toStderr (D.vcat (docs ++ [ D.fromChars "" ]))) + |> Task.bind + (\_ -> + if denyWarnings then + Exit.exitFailure + + else + Task.pure () + ) + ) warningToDoc : Target -> FilePath -> W.Module -> Task Never D.Doc From cd1be55c63320ae1c980895f65811e1ec43902ea Mon Sep 17 00:00:00 2001 From: Decio Ferreira Date: Mon, 9 Mar 2026 23:45:58 +0000 Subject: [PATCH 04/11] feat: add --no-warnings flag to backwards compatibility test command --- tests/backwards-compatibility.test.js | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/backwards-compatibility.test.js b/tests/backwards-compatibility.test.js index 6199fbd21..d2848c8d5 100644 --- a/tests/backwards-compatibility.test.js +++ b/tests/backwards-compatibility.test.js @@ -76,7 +76,7 @@ describe("backwards compatibility", () => { try { child_process.execSync( - `../bin/index.js make src/${example}.elm ${commandFlag} --output ${guidaOutput}`, + `../bin/index.js make src/${example}.elm ${commandFlag} --output ${guidaOutput} --no-warnings`, { cwd: path.join(__dirname, "..", "examples") } From b045ddae04fda51fd15d53662d3d89f405e5e69e Mon Sep 17 00:00:00 2001 From: Decio Ferreira Date: Mon, 9 Mar 2026 23:52:16 +0000 Subject: [PATCH 05/11] feat: update buildPaths to support suppressing warnings and modify related logic --- src/API/Make.elm | 8 ++++---- src/Builder/Build.elm | 8 ++++---- src/Builder/Reporting.elm | 10 +++++----- src/Terminal/Make.elm | 9 ++++----- src/Terminal/Test.elm | 2 +- 5 files changed, 18 insertions(+), 19 deletions(-) diff --git a/src/API/Make.elm b/src/API/Make.elm index cc4c11057..317cf733a 100644 --- a/src/API/Make.elm +++ b/src/API/Make.elm @@ -89,7 +89,7 @@ runHelp root path (Flags debug optimize withSourceMaps) = Task.eio Exit.MakeBadDetails (Details.load style scope root) |> Task.bind (\details -> - buildPaths style root details False (NE.Nonempty path []) + buildPaths style root details False False (NE.Nonempty path []) |> Task.bind (\((Build.Artifacts warnings _ _ _ _) as artifacts) -> case getMains artifacts of @@ -149,10 +149,10 @@ getMode debug optimize = -- BUILD PROJECTS -buildPaths : Reporting.Style -> Stuff.Root -> Details.Details -> Bool -> NE.Nonempty FilePath -> Task Exit.Make Build.Artifacts -buildPaths style root details denyWarnings paths = +buildPaths : Reporting.Style -> Stuff.Root -> Details.Details -> Bool -> Bool -> NE.Nonempty FilePath -> Task Exit.Make Build.Artifacts +buildPaths style root details suppressWarnings denyWarnings paths = Task.eio Exit.MakeCannotBuild <| - Build.fromPaths style root details denyWarnings paths + Build.fromPaths style root details suppressWarnings denyWarnings paths diff --git a/src/Builder/Build.elm b/src/Builder/Build.elm index edc8e7e57..4b28f28a4 100644 --- a/src/Builder/Build.elm +++ b/src/Builder/Build.elm @@ -135,7 +135,7 @@ forkWithKey toComparable keyComparison encoder func dict = fromExposed : BD.Decoder docs -> (docs -> BE.Encoder) -> Reporting.Style -> Stuff.Root -> Details.Details -> DocsGoal docs -> NE.Nonempty ModuleName.Raw -> Task Never (Result Exit.BuildProblem docs) fromExposed docsDecoder docsEncoder style root details docsGoal ((NE.Nonempty e es) as exposed) = - Reporting.trackBuild docsDecoder docsEncoder style (\_ -> ( 0, False )) <| + Reporting.trackBuild docsDecoder docsEncoder style (\_ -> ( 0, False, False )) <| \key -> makeEnv key root details |> Task.bind @@ -221,9 +221,9 @@ type alias Dependencies = Dict (List String) TypeCheck.Canonical I.DependencyInterface -fromPaths : Reporting.Style -> Stuff.Root -> Details.Details -> Bool -> NE.Nonempty FilePath -> Task Never (Result Exit.BuildProblem Artifacts) -fromPaths style root details denyWarnings paths = - Reporting.trackBuild artifactsDecoder artifactsEncoder style (\(Artifacts warnings _ _ _ _) -> ( List.length warnings, denyWarnings )) <| +fromPaths : Reporting.Style -> Stuff.Root -> Details.Details -> Bool -> Bool -> NE.Nonempty FilePath -> Task Never (Result Exit.BuildProblem Artifacts) +fromPaths style root details suppressWarnings denyWarnings paths = + Reporting.trackBuild artifactsDecoder artifactsEncoder style (\(Artifacts warnings _ _ _ _) -> ( List.length warnings, suppressWarnings, denyWarnings )) <| \key -> makeEnv key root details |> Task.bind diff --git a/src/Builder/Reporting.elm b/src/Builder/Reporting.elm index 967872ed9..a7a4f8e8d 100644 --- a/src/Builder/Reporting.elm +++ b/src/Builder/Reporting.elm @@ -370,7 +370,7 @@ type alias BResult a = Result Exit.BuildProblem a -trackBuild : BD.Decoder a -> (a -> BE.Encoder) -> Style -> (a -> ( Int, Bool )) -> (BKey -> Task Never (BResult a)) -> Task Never (BResult a) +trackBuild : BD.Decoder a -> (a -> BE.Encoder) -> Style -> (a -> ( Int, Bool, Bool )) -> (BKey -> Task Never (BResult a)) -> Task Never (BResult a) trackBuild decoder encoder style extractWarningInfo callback = case style of Silent -> @@ -407,7 +407,7 @@ type BMsg = BDone -buildLoop : BD.Decoder a -> Chan (Result BMsg (BResult a)) -> Int -> (a -> ( Int, Bool )) -> Task Never () +buildLoop : BD.Decoder a -> Chan (Result BMsg (BResult a)) -> Int -> (a -> ( Int, Bool, Bool )) -> Task Never () buildLoop decoder chan done extractWarningInfo = Utils.readChan (BD.result bMsgDecoder (bResultDecoder decoder)) chan |> Task.bind @@ -443,12 +443,12 @@ buildLoop decoder chan done extractWarningInfo = ) -toFinalMessage : Int -> (a -> ( Int, Bool )) -> BResult a -> String +toFinalMessage : Int -> (a -> ( Int, Bool, Bool )) -> BResult a -> String toFinalMessage done extractWarningInfo result = case result of Ok value -> let - ( warningCount, denyWarnings ) = + ( warningCount, suppressWarnings, denyWarnings ) = extractWarningInfo value in if denyWarnings && warningCount > 0 then @@ -467,7 +467,7 @@ toFinalMessage done extractWarningInfo result = let warningNote : String warningNote = - if warningCount == 0 then + if suppressWarnings || warningCount == 0 then "" else if warningCount == 1 then diff --git a/src/Terminal/Make.elm b/src/Terminal/Make.elm index 54abbda33..1101a2467 100644 --- a/src/Terminal/Make.elm +++ b/src/Terminal/Make.elm @@ -257,17 +257,16 @@ buildExposed style root details maybeDocs exposed = buildPaths : Reporting.Style -> Stuff.Root -> Details.Details -> Warnings -> NE.Nonempty FilePath -> Task Exit.Make Build.Artifacts buildPaths style root details warnings paths = let - denyWarnings : Bool - denyWarnings = + ( suppressWarnings, denyWarnings ) = case warnings of NoWarnings -> - False + ( True, False ) Warnings deny -> - deny + ( False, deny ) in Task.eio Exit.MakeCannotBuild <| - Build.fromPaths style root details denyWarnings paths + Build.fromPaths style root details suppressWarnings denyWarnings paths diff --git a/src/Terminal/Test.elm b/src/Terminal/Test.elm index 90ef14138..c7384c791 100644 --- a/src/Terminal/Test.elm +++ b/src/Terminal/Test.elm @@ -1268,7 +1268,7 @@ runMake root path = buildPaths : Stuff.Root -> Details.Details -> NE.Nonempty FilePath -> Task Exit.Test Build.Artifacts buildPaths root details paths = Task.eio Exit.TestCannotBuild <| - Build.fromPaths Reporting.silent root details False paths + Build.fromPaths Reporting.silent root details False False paths From c0734427f3afabe3ba00faccef7bf105dd69cb3b Mon Sep 17 00:00:00 2001 From: Decio Ferreira Date: Mon, 9 Mar 2026 23:55:54 +0000 Subject: [PATCH 06/11] feat: update warning handling in fromPaths to sum warnings instead of counting --- src/Builder/Build.elm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Builder/Build.elm b/src/Builder/Build.elm index 4b28f28a4..eb8ed0fb3 100644 --- a/src/Builder/Build.elm +++ b/src/Builder/Build.elm @@ -223,7 +223,7 @@ type alias Dependencies = fromPaths : Reporting.Style -> Stuff.Root -> Details.Details -> Bool -> Bool -> NE.Nonempty FilePath -> Task Never (Result Exit.BuildProblem Artifacts) fromPaths style root details suppressWarnings denyWarnings paths = - Reporting.trackBuild artifactsDecoder artifactsEncoder style (\(Artifacts warnings _ _ _ _) -> ( List.length warnings, suppressWarnings, denyWarnings )) <| + Reporting.trackBuild artifactsDecoder artifactsEncoder style (\(Artifacts warnModules _ _ _ _) -> ( List.length (List.concatMap .warnings warnModules), suppressWarnings, denyWarnings )) <| \key -> makeEnv key root details |> Task.bind From 036c478f775be7de2341fae0a65b3cc575b05c8b Mon Sep 17 00:00:00 2001 From: Decio Ferreira Date: Tue, 10 Mar 2026 18:05:06 +0000 Subject: [PATCH 07/11] feat: enhance result handling by adding runWithInfo and modifyInfo functions --- src/Compiler/Canonicalize/Module.elm | 412 ++++++++++++++++++++++++++- src/Compiler/Compile.elm | 7 +- src/Compiler/Reporting/Result.elm | 27 ++ 3 files changed, 442 insertions(+), 4 deletions(-) diff --git a/src/Compiler/Canonicalize/Module.elm b/src/Compiler/Canonicalize/Module.elm index f42f5d9d0..7e11961e7 100644 --- a/src/Compiler/Canonicalize/Module.elm +++ b/src/Compiler/Canonicalize/Module.elm @@ -14,6 +14,7 @@ import Compiler.Canonicalize.Type as Type import Compiler.Data.Index as Index import Compiler.Data.Name as Name exposing (Name) import Compiler.Generate.Target exposing (Target) +import Compiler.Guida.Compiler.Imports as DefaultImports import Compiler.Guida.Interface as I import Compiler.Guida.ModuleName as ModuleName import Compiler.Guida.Package as Pkg @@ -24,6 +25,7 @@ import Compiler.Reporting.Result as R import Compiler.Reporting.Warning as W import Data.Graph as Graph import Data.Map as Dict exposing (Dict) +import Data.Set as EverySet import System.TypeCheck.IO as IO import Utils.Crash exposing (crash) @@ -37,10 +39,28 @@ type alias MResult i w a = +-- USED MODULES TRACKING + + +type alias UsedModules = + EverySet.EverySet String ModuleName.Raw + + +trackModule : ModuleName.Raw -> UsedModules -> UsedModules +trackModule moduleName used = + EverySet.insert identity moduleName used + + +trackCanonical : IO.Canonical -> UsedModules -> UsedModules +trackCanonical (IO.Canonical _ moduleName) used = + trackModule moduleName used + + + -- MODULES -canonicalize : Target -> Stuff.Root -> Pkg.Name -> Dict String ModuleName.Raw I.Interface -> Src.Module -> MResult i (List W.Warning) Can.Module +canonicalize : Target -> Stuff.Root -> Pkg.Name -> Dict String ModuleName.Raw I.Interface -> Src.Module -> MResult UsedModules (List W.Warning) Can.Module canonicalize target root pkg ifaces ((Src.Module syntaxVersion _ exports docs imports values _ _ binops effects) as modul) = let home : IO.Canonical @@ -66,12 +86,402 @@ canonicalize target root pkg ifaces ((Src.Module syntaxVersion _ exports docs im (\cexports -> Can.Module home cexports docs cvalues cunions caliases cbinops ceffects ) + |> R.bind + (\canModule -> + extractUsedModules canModule + |> R.bind + (\() -> + generateUnusedImportWarnings target imports + |> R.fmap (\() -> canModule) + ) + ) ) ) ) +-- EXTRACT USED MODULES FROM CANONICAL AST + + +extractUsedModules : Can.Module -> MResult UsedModules (List W.Warning) () +extractUsedModules (Can.Module _ _ _ decls unions aliases _ effects) = + extractUsedFromDecls decls + |> R.bind (\() -> extractUsedFromUnions unions) + |> R.bind (\() -> extractUsedFromAliases aliases) + |> R.bind (\() -> extractUsedFromEffects effects) + + +extractUsedFromDecls : Can.Decls -> MResult UsedModules (List W.Warning) () +extractUsedFromDecls decls = + case decls of + Can.SaveTheEnvironment -> + R.ok () + + Can.Declare def rest -> + extractUsedFromDef def + |> R.bind (\() -> extractUsedFromDecls rest) + + Can.DeclareRec def defs rest -> + extractUsedFromDef def + |> R.bind (\() -> R.traverse extractUsedFromDef defs) + |> R.bind (\_ -> extractUsedFromDecls rest) + + +extractUsedFromDef : Can.Def -> MResult UsedModules (List W.Warning) () +extractUsedFromDef def = + case def of + Can.Def _ patterns expr -> + R.traverse extractUsedFromPattern patterns + |> R.bind (\_ -> extractUsedFromExpr expr) + + Can.TypedDef _ _ patternsAndTypes expr tipe -> + R.traverse (\( p, t ) -> extractUsedFromPattern p |> R.bind (\() -> extractUsedFromType t)) patternsAndTypes + |> R.bind (\_ -> extractUsedFromExpr expr) + |> R.bind (\() -> extractUsedFromType tipe) + + +extractUsedFromExpr : Can.Expr -> MResult UsedModules (List W.Warning) () +extractUsedFromExpr (A.At _ expr_) = + case expr_ of + Can.VarLocal _ -> + R.ok () + + Can.VarTopLevel _ _ -> + R.ok () + + Can.VarKernel _ _ -> + R.ok () + + Can.VarForeign home _ _ -> + trackHome home + + Can.VarCtor _ home _ _ _ -> + trackHome home + + Can.VarDebug home _ _ -> + trackHome home + + Can.VarOperator _ home _ _ -> + trackHome home + + Can.Chr _ -> + R.ok () + + Can.Str _ -> + R.ok () + + Can.Int _ -> + R.ok () + + Can.Float _ -> + R.ok () + + Can.List exprs -> + R.traverse extractUsedFromExpr exprs + |> R.fmap (\_ -> ()) + + Can.Negate expr -> + extractUsedFromExpr expr + + Can.Binop _ home _ _ left right -> + trackHome home + |> R.bind (\() -> extractUsedFromExpr left) + |> R.bind (\() -> extractUsedFromExpr right) + + Can.Lambda patterns body -> + R.traverse extractUsedFromPattern patterns + |> R.bind (\_ -> extractUsedFromExpr body) + + Can.Call func args -> + extractUsedFromExpr func + |> R.bind (\() -> R.traverse extractUsedFromExpr args) + |> R.fmap (\_ -> ()) + + Can.If branches final -> + R.traverse (\( cond, branch ) -> extractUsedFromExpr cond |> R.bind (\() -> extractUsedFromExpr branch)) branches + |> R.bind (\_ -> extractUsedFromExpr final) + + Can.Let def body -> + extractUsedFromDef def + |> R.bind (\() -> extractUsedFromExpr body) + + Can.LetRec defs body -> + R.traverse extractUsedFromDef defs + |> R.bind (\_ -> extractUsedFromExpr body) + + Can.LetDestruct pattern expr body -> + extractUsedFromPattern pattern + |> R.bind (\() -> extractUsedFromExpr expr) + |> R.bind (\() -> extractUsedFromExpr body) + + Can.Case expr branches -> + extractUsedFromExpr expr + |> R.bind (\() -> R.traverse extractUsedFromCaseBranch branches) + |> R.fmap (\_ -> ()) + + Can.Accessor _ -> + R.ok () + + Can.Access expr _ -> + extractUsedFromExpr expr + + Can.Update expr fields -> + let + extractFromFieldUpdate ( _, Can.FieldUpdate _ e ) = + extractUsedFromExpr e + in + extractUsedFromExpr expr + |> R.bind (\() -> R.traverse extractFromFieldUpdate (Dict.toList A.compareLocated fields)) + |> R.fmap (\_ -> ()) + + Can.Record fields -> + R.traverse (\( _, expr ) -> extractUsedFromExpr expr) (Dict.toList A.compareLocated fields) + |> R.fmap (\_ -> ()) + + Can.Unit -> + R.ok () + + Can.Tuple a b rest -> + extractUsedFromExpr a + |> R.bind (\() -> extractUsedFromExpr b) + |> R.bind (\() -> R.traverse extractUsedFromExpr rest) + |> R.fmap (\_ -> ()) + + Can.Shader _ _ -> + R.ok () + + +extractUsedFromCaseBranch : Can.CaseBranch -> MResult UsedModules (List W.Warning) () +extractUsedFromCaseBranch (Can.CaseBranch pattern expr) = + extractUsedFromPattern pattern + |> R.bind (\() -> extractUsedFromExpr expr) + + +extractUsedFromPattern : Can.Pattern -> MResult UsedModules (List W.Warning) () +extractUsedFromPattern (A.At _ pattern_) = + case pattern_ of + Can.PAnything -> + R.ok () + + Can.PVar _ -> + R.ok () + + Can.PRecord _ -> + R.ok () + + Can.PAlias subPattern _ -> + extractUsedFromPattern subPattern + + Can.PUnit -> + R.ok () + + Can.PTuple a b rest -> + extractUsedFromPattern a + |> R.bind (\() -> extractUsedFromPattern b) + |> R.bind (\() -> R.traverse extractUsedFromPattern rest) + |> R.fmap (\_ -> ()) + + Can.PList patterns -> + R.traverse extractUsedFromPattern patterns + |> R.fmap (\_ -> ()) + + Can.PCons head tail -> + extractUsedFromPattern head + |> R.bind (\() -> extractUsedFromPattern tail) + + Can.PBool _ _ -> + R.ok () + + Can.PChr _ -> + R.ok () + + Can.PStr _ _ -> + R.ok () + + Can.PInt _ -> + R.ok () + + Can.PCtor { home, args } -> + trackHome home + |> R.bind (\() -> R.traverse (\(Can.PatternCtorArg _ _ p) -> extractUsedFromPattern p) args) + |> R.fmap (\_ -> ()) + + +extractUsedFromType : Can.Type -> MResult UsedModules (List W.Warning) () +extractUsedFromType tipe = + case tipe of + Can.TLambda arg result -> + extractUsedFromType arg + |> R.bind (\() -> extractUsedFromType result) + + Can.TVar _ -> + R.ok () + + Can.TType home _ args -> + trackHome home + |> R.bind (\() -> R.traverse extractUsedFromType args) + |> R.fmap (\_ -> ()) + + Can.TRecord fields _ -> + R.traverse extractUsedFromFieldType (Dict.values compare fields) + |> R.fmap (\_ -> ()) + + Can.TUnit -> + R.ok () + + Can.TTuple a b rest -> + extractUsedFromType a + |> R.bind (\() -> extractUsedFromType b) + |> R.bind (\() -> R.traverse extractUsedFromType rest) + |> R.fmap (\_ -> ()) + + Can.TAlias home _ args aliasType -> + trackHome home + |> R.bind (\() -> R.traverse (\( _, t ) -> extractUsedFromType t) args) + |> R.fmap (\_ -> ()) + |> R.bind (\() -> extractUsedFromAliasType aliasType) + + +extractUsedFromFieldType : Can.FieldType -> MResult UsedModules (List W.Warning) () +extractUsedFromFieldType (Can.FieldType _ tipe) = + extractUsedFromType tipe + + +extractUsedFromAliasType : Can.AliasType -> MResult UsedModules (List W.Warning) () +extractUsedFromAliasType aliasType = + case aliasType of + Can.Holey tipe -> + extractUsedFromType tipe + + Can.Filled tipe -> + extractUsedFromType tipe + + +extractUsedFromUnions : Dict String Name Can.Union -> MResult UsedModules (List W.Warning) () +extractUsedFromUnions unions = + R.traverse extractUsedFromUnion (Dict.values compare unions) + |> R.fmap (\_ -> ()) + + +extractUsedFromUnion : Can.Union -> MResult UsedModules (List W.Warning) () +extractUsedFromUnion (Can.Union _ ctors _ _) = + R.traverse extractUsedFromCtor ctors + |> R.fmap (\_ -> ()) + + +extractUsedFromCtor : Can.Ctor -> MResult UsedModules (List W.Warning) () +extractUsedFromCtor (Can.Ctor _ _ _ types) = + R.traverse extractUsedFromType types + |> R.fmap (\_ -> ()) + + +extractUsedFromAliases : Dict String Name Can.Alias -> MResult UsedModules (List W.Warning) () +extractUsedFromAliases aliases = + R.traverse extractUsedFromAlias (Dict.values compare aliases) + |> R.fmap (\_ -> ()) + + +extractUsedFromAlias : Can.Alias -> MResult UsedModules (List W.Warning) () +extractUsedFromAlias (Can.Alias _ tipe) = + extractUsedFromType tipe + + +extractUsedFromEffects : Can.Effects -> MResult UsedModules (List W.Warning) () +extractUsedFromEffects effects = + case effects of + Can.NoEffects -> + R.ok () + + Can.Ports ports -> + R.traverse extractUsedFromPort (Dict.values compare ports) + |> R.fmap (\_ -> ()) + + Can.Manager _ _ _ manager -> + extractUsedFromManager manager + + +extractUsedFromPort : Can.Port -> MResult UsedModules (List W.Warning) () +extractUsedFromPort portDef = + case portDef of + Can.Incoming { payload } -> + extractUsedFromType payload + + Can.Outgoing { payload } -> + extractUsedFromType payload + + +extractUsedFromManager : Can.Manager -> MResult UsedModules (List W.Warning) () +extractUsedFromManager manager = + case manager of + Can.Cmd _ -> + R.ok () + + Can.Sub _ -> + R.ok () + + Can.Fx _ _ -> + R.ok () + + +trackHome : IO.Canonical -> MResult UsedModules (List W.Warning) () +trackHome home = + R.modifyInfo (trackCanonical home) + + + +-- GENERATE UNUSED IMPORT WARNINGS + + +generateUnusedImportWarnings : Target -> List Src.Import -> MResult UsedModules (List W.Warning) () +generateUnusedImportWarnings target imports = + R.getInfo + |> R.bind + (\usedModules -> + let + importsToCheck : List Src.Import + importsToCheck = + removeImplicitDefaults target imports + + unusedImports : List ( ModuleName.Raw, A.Region ) + unusedImports = + List.filterMap (checkImportUsed usedModules) importsToCheck + in + R.traverse warnUnusedImport unusedImports + |> R.fmap (\_ -> ()) + ) + + +removeImplicitDefaults : Target -> List Src.Import -> List Src.Import +removeImplicitDefaults target imports = + let + defaultNames : EverySet.EverySet String ModuleName.Raw + defaultNames = + EverySet.fromList identity (List.map Src.getImportName (List.map Src.c1Value (DefaultImports.defaults target))) + in + List.filter (isExplicitImport defaultNames) imports + + +isExplicitImport : EverySet.EverySet String ModuleName.Raw -> Src.Import -> Bool +isExplicitImport defaultNames (Src.Import ( _, A.At (A.Region (A.Position startRow _) _) name ) _ _) = + not (EverySet.member identity name defaultNames && startRow <= 1) + + +checkImportUsed : UsedModules -> Src.Import -> Maybe ( ModuleName.Raw, A.Region ) +checkImportUsed usedModules (Src.Import ( _, A.At region name ) _ _) = + if EverySet.member identity name usedModules then + Nothing + + else + Just ( name, region ) + + +warnUnusedImport : ( ModuleName.Raw, A.Region ) -> MResult UsedModules (List W.Warning) () +warnUnusedImport ( name, region ) = + R.warn (W.UnusedImport region name) + + + -- CANONICALIZE BINOP diff --git a/src/Compiler/Compile.elm b/src/Compiler/Compile.elm index f0615d743..ecbea5377 100644 --- a/src/Compiler/Compile.elm +++ b/src/Compiler/Compile.elm @@ -22,6 +22,7 @@ import Compiler.Reporting.Warning as W import Compiler.Type.Constrain.Module as Type import Compiler.Type.Solve as Type import Data.Map exposing (Dict) +import Data.Set as EverySet import System.TypeCheck.IO as TypeCheck import Task exposing (Task) import Utils.Task.Extra as Task @@ -71,11 +72,11 @@ compile target root pkg ifaces modul = canonicalize : Target -> Stuff.Root -> Pkg.Name -> Dict String ModuleName.Raw I.Interface -> Src.Module -> ( List W.Warning, Result E.Error Can.Module ) canonicalize target root pkg ifaces modul = - case R.run (Canonicalize.canonicalize target root pkg ifaces modul) of - ( warnings, Ok canonical ) -> + case R.runWithInfo EverySet.empty (Canonicalize.canonicalize target root pkg ifaces modul) of + ( _, warnings, Ok canonical ) -> ( warnings, Ok canonical ) - ( warnings, Err errors ) -> + ( _, warnings, Err errors ) -> ( warnings, Err (E.BadNames errors) ) diff --git a/src/Compiler/Reporting/Result.elm b/src/Compiler/Reporting/Result.elm index 1393535f8..d286eacee 100644 --- a/src/Compiler/Reporting/Result.elm +++ b/src/Compiler/Reporting/Result.elm @@ -5,12 +5,15 @@ module Compiler.Reporting.Result exposing , apply , bind , fmap + , getInfo , indexedTraverse , loop , mapTraverseWithKey + , modifyInfo , ok , pure , run + , runWithInfo , throw , traverse , traverseDict @@ -46,6 +49,16 @@ run (RResult k) = ( List.reverse w, Err e ) +runWithInfo : i -> RResult i (List w) e a -> ( i, List w, Result (OneOrMore.OneOrMore e) a ) +runWithInfo initialInfo (RResult k) = + case k initialInfo [] of + ROk finalInfo w a -> + ( finalInfo, List.reverse w, Ok a ) + + RErr finalInfo w e -> + ( finalInfo, List.reverse w, Err e ) + + -- LOOP @@ -102,6 +115,20 @@ throw e = RErr i w (OneOrMore.one e) +modifyInfo : (i -> i) -> RResult i w e () +modifyInfo f = + RResult <| + \i w -> + ROk (f i) w () + + +getInfo : RResult i w e i +getInfo = + RResult <| + \i w -> + ROk i w i + + -- FANCY INSTANCE STUFF From e441488318823ab06e786f52f81c4f4b3419207d Mon Sep 17 00:00:00 2001 From: Decio Ferreira Date: Thu, 12 Mar 2026 21:29:52 +0000 Subject: [PATCH 08/11] Work on warnings handling and reporting - refactor: simplify warning reporting by removing file reads in warningToReport and warningToDoc - fix: improve failure message formatting in warning reporting - feat: add tests for warning handling with --no-warnings and --deny-warnings flags --- src/API/Make.elm | 16 +++--- src/Builder/Reporting.elm | 2 +- src/Terminal/Make.elm | 110 +++++++++++++++++++------------------- tests/make.test.js | 89 ++++++++++++++++++++++++++++++ 4 files changed, 150 insertions(+), 67 deletions(-) create mode 100644 tests/make.test.js diff --git a/src/API/Make.elm b/src/API/Make.elm index 317cf733a..2f3f07174 100644 --- a/src/API/Make.elm +++ b/src/API/Make.elm @@ -13,7 +13,6 @@ module API.Make exposing import Builder.BackgroundWriter as BW import Builder.Build as Build -import Builder.File as File import Builder.Generate as Generate import Builder.Guida.Details as Details import Builder.Reporting as Reporting @@ -160,15 +159,12 @@ buildPaths style root details suppressWarnings denyWarnings paths = warningToReport : Target -> W.Module -> Task Never Report.WarningModuleReport -warningToReport target { absolutePath, name, warnings } = - File.readUtf8 absolutePath - |> Task.fmap - (\sourceCode -> - { path = absolutePath - , name = name - , warnings = List.map (W.toReport target L.empty (Code.toSource sourceCode)) warnings - } - ) +warningToReport target { absolutePath, name, source, warnings } = + Task.pure + { path = absolutePath + , name = name + , warnings = List.map (W.toReport target L.empty (Code.toSource source)) warnings + } diff --git a/src/Builder/Reporting.elm b/src/Builder/Reporting.elm index a7a4f8e8d..759193908 100644 --- a/src/Builder/Reporting.elm +++ b/src/Builder/Reporting.elm @@ -461,7 +461,7 @@ toFinalMessage done extractWarningInfo result = else "warnings" in - "Failed! " ++ String.fromInt warningCount ++ " " ++ warningWord ++ " with --deny-warnings enabled." + "Failed! (" ++ String.fromInt warningCount ++ " " ++ warningWord ++ ")" else let diff --git a/src/Terminal/Make.elm b/src/Terminal/Make.elm index 1101a2467..5b373999d 100644 --- a/src/Terminal/Make.elm +++ b/src/Terminal/Make.elm @@ -110,53 +110,55 @@ runHelp root paths style (Flags debug optimize withSourceMaps noWarnings denyWar buildPaths style root details warnings (NE.Nonempty p ps) |> Task.bind (\artifacts -> - (case maybeOutput of - Nothing -> - case getMains artifacts of - [] -> - Task.pure () - - [ name ] -> - toBuilder withSourceMaps Html.leadingLines root details desiredMode artifacts - |> Task.bind - (\builder -> - generate style "index.html" (Html.sandwich (Stuff.rootToTarget root) name builder) (NE.Nonempty name []) - ) - - name :: names -> - toBuilder withSourceMaps 0 root details desiredMode artifacts - |> Task.bind - (\builder -> - generate style "guida.js" builder (NE.Nonempty name names) - ) - - Just DevNull -> - Task.pure () - - Just (JS target) -> - case getNoMains artifacts of - [] -> - toBuilder withSourceMaps 0 root details desiredMode artifacts - |> Task.bind - (\builder -> - generate style target builder (Build.getRootNames artifacts) - ) - - name :: names -> - Task.throw (Exit.MakeNonMainFilesIntoJavaScript name names) - - Just (Html target) -> - hasOneMain artifacts - |> Task.bind - (\name -> - toBuilder withSourceMaps Html.leadingLines root details desiredMode artifacts + Task.io (reportWarnings warnings root artifacts) + |> Task.bind + (\_ -> + case maybeOutput of + Nothing -> + case getMains artifacts of + [] -> + Task.pure () + + [ name ] -> + toBuilder withSourceMaps Html.leadingLines root details desiredMode artifacts + |> Task.bind + (\builder -> + generate style "index.html" (Html.sandwich (Stuff.rootToTarget root) name builder) (NE.Nonempty name []) + ) + + name :: names -> + toBuilder withSourceMaps 0 root details desiredMode artifacts + |> Task.bind + (\builder -> + generate style "guida.js" builder (NE.Nonempty name names) + ) + + Just DevNull -> + Task.pure () + + Just (JS target) -> + case getNoMains artifacts of + [] -> + toBuilder withSourceMaps 0 root details desiredMode artifacts + |> Task.bind + (\builder -> + generate style target builder (Build.getRootNames artifacts) + ) + + name :: names -> + Task.throw (Exit.MakeNonMainFilesIntoJavaScript name names) + + Just (Html target) -> + hasOneMain artifacts |> Task.bind - (\builder -> - generate style target (Html.sandwich (Stuff.rootToTarget root) name builder) (NE.Nonempty name []) + (\name -> + toBuilder withSourceMaps Html.leadingLines root details desiredMode artifacts + |> Task.bind + (\builder -> + generate style target (Html.sandwich (Stuff.rootToTarget root) name builder) (NE.Nonempty name []) + ) ) - ) - ) - |> Task.bind (\_ -> Task.io (reportWarnings warnings root artifacts)) + ) ) ) ) @@ -386,17 +388,13 @@ reportWarnings warnings root (Build.Artifacts warnList _ _ _ _) = warningToDoc : Target -> FilePath -> W.Module -> Task Never D.Doc -warningToDoc target rootPath { absolutePath, warnings } = - File.readUtf8 absolutePath - |> Task.fmap - (\sourceCode -> - let - reports : List Report.Report - reports = - List.map (W.toReport target L.empty (Code.toSource sourceCode)) warnings - in - D.vcat (List.map (reportToDoc rootPath absolutePath) reports) - ) +warningToDoc target rootPath { absolutePath, source, warnings } = + let + reports : List Report.Report + reports = + List.map (W.toReport target L.empty (Code.toSource source)) warnings + in + Task.pure (D.vcat (List.map (reportToDoc rootPath absolutePath) reports)) reportToDoc : FilePath -> FilePath -> Report.Report -> D.Doc diff --git a/tests/make.test.js b/tests/make.test.js new file mode 100644 index 000000000..72c5be680 --- /dev/null +++ b/tests/make.test.js @@ -0,0 +1,89 @@ +const fs = require("node:fs"); +const path = require("node:path"); +const child_process = require("node:child_process"); +const tmp = require("tmp"); +const util = require("node:util"); + +const setupProject = () => { + const tmpobj = tmp.dirSync(); + + child_process.execSync(`${path.join(__dirname, "..", "bin", "index.js")} init --yes`, { + cwd: tmpobj.name, + stdio: "pipe" + }); + + fs.writeFileSync(path.join(tmpobj.name, "src", "WarningFlags.guida"), `module WarningFlags exposing (main) + +import List exposing (map) + +main : Program () () () +main = + Platform.worker + { init = \\_ -> ( (), Cmd.none ) + , update = \\_ model -> ( model, Cmd.none ) + , subscriptions = \\_ -> Sub.none + } + +noTypeAnnotationFn unusedVar = + 1 +`); + + return tmpobj; +}; + +const runMake = (cwd, args) => { + const result = child_process.spawnSync( + path.join(__dirname, "..", "bin", "index.js"), + ["make", "src/WarningFlags.guida", "--output", "warning-flags.js", ...args], + { cwd, encoding: "utf-8" } + ); + + return { + status: result.status, + stdout: util.stripVTControlCharacters(result.stdout || ""), + stderr: util.stripVTControlCharacters(result.stderr || "") + }; +}; + +describe("guida make warning flags", () => { + it("suppresses warnings with --no-warnings", () => { + const tmpobj = setupProject(); + + const result = runMake(tmpobj.name, ["--no-warnings"]); + + expect(result.status).toBe(0); + expect(result.stderr).not.toMatch(/UNUSED IMPORT|UNUSED VARIABLE|MISSING TYPE ANNOTATION/); + expect(fs.existsSync(path.join(tmpobj.name, "warning-flags.js"))).toBe(true); + }); + + it("fails with --deny-warnings when warnings are present", () => { + const tmpobj = setupProject(); + + const result = runMake(tmpobj.name, ["--deny-warnings"]); + + expect(result.status).toBe(1); + expect(result.stderr).toMatch(/UNUSED IMPORT/); + expect(result.stderr).toMatch(/UNUSED VARIABLE/); + expect(result.stderr).toMatch(/MISSING TYPE ANNOTATION/); + }); + + it("does not write output file with --deny-warnings", () => { + const tmpobj = setupProject(); + + const result = runMake(tmpobj.name, ["--deny-warnings"]); + + expect(result.status).toBe(1); + expect(fs.existsSync(path.join(tmpobj.name, "warning-flags.js"))).toBe(false); + }); + + it("fails when combining --no-warnings and --deny-warnings", () => { + const tmpobj = setupProject(); + + const result = runMake(tmpobj.name, ["--no-warnings", "--deny-warnings"]); + + expect(result.status).toBe(1); + expect(result.stderr).toMatch(/CLASHING FLAGS/); + expect(result.stderr).toMatch(/--no-warnings/); + expect(result.stderr).toMatch(/--deny-warnings/); + }); +}); From 2cdde98ac07f5b4d8dded1260a0396214b3d41c6 Mon Sep 17 00:00:00 2001 From: Decio Ferreira Date: Thu, 12 Mar 2026 21:46:49 +0000 Subject: [PATCH 09/11] feat: expose UsedModules type in Compiler.Canonicalize.Module and add extractFromFieldUpdate function signature --- src/Compiler/Canonicalize/Module.elm | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/Compiler/Canonicalize/Module.elm b/src/Compiler/Canonicalize/Module.elm index 7e11961e7..0a5c680e9 100644 --- a/src/Compiler/Canonicalize/Module.elm +++ b/src/Compiler/Canonicalize/Module.elm @@ -1,4 +1,8 @@ -module Compiler.Canonicalize.Module exposing (MResult, canonicalize) +module Compiler.Canonicalize.Module exposing + ( MResult + , UsedModules + , canonicalize + ) import Builder.Stuff as Stuff import Compiler.AST.Canonical as Can @@ -228,6 +232,7 @@ extractUsedFromExpr (A.At _ expr_) = Can.Update expr fields -> let + extractFromFieldUpdate : ( a, Can.FieldUpdate ) -> MResult UsedModules (List W.Warning) () extractFromFieldUpdate ( _, Can.FieldUpdate _ e ) = extractUsedFromExpr e in From 415567c4d5263c52cb74f79e837d778366a7e1c2 Mon Sep 17 00:00:00 2001 From: Decio Ferreira Date: Sat, 9 May 2026 16:34:37 +0100 Subject: [PATCH 10/11] fix: standardize warning report titles to lowercase --- src/Compiler/Reporting/Warning.elm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Compiler/Reporting/Warning.elm b/src/Compiler/Reporting/Warning.elm index ab3a56077..514b595eb 100644 --- a/src/Compiler/Reporting/Warning.elm +++ b/src/Compiler/Reporting/Warning.elm @@ -63,7 +63,7 @@ toReport : Target -> L.Localizer -> Code.Source -> Warning -> Report toReport target localizer source warning = case warning of UnusedImport region moduleName -> - Report "UNUSED IMPORT" region [] <| + Report "unused import" region [] <| Code.toSnippet source region Nothing <| ( D.reflow ("Nothing from the `" ++ moduleName ++ "` module is used in this file.") , D.fromChars "I recommend removing unused imports." @@ -73,7 +73,7 @@ toReport target localizer source warning = let title : String title = - defOrPat context "UNUSED DEFINITION" "UNUSED VARIABLE" + defOrPat context "unused definition" "unused variable" in Report title region [] <| Code.toSnippet source region Nothing <| @@ -94,7 +94,7 @@ toReport target localizer source warning = ) MissingTypeAnnotation region name inferredType -> - Report "MISSING TYPE ANNOTATION" region [] <| + Report "missing type annotation" region [] <| Code.toSnippet source region Nothing <| ( D.reflow <| case Type.deepDealias inferredType of From 41717310b0ab689550651833be83fd0698e2f55d Mon Sep 17 00:00:00 2001 From: Decio Ferreira Date: Sat, 9 May 2026 19:52:46 +0100 Subject: [PATCH 11/11] fix: standardize warning messages to lowercase in tests --- tests/make.test.js | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/make.test.js b/tests/make.test.js index 72c5be680..ab85e0010 100644 --- a/tests/make.test.js +++ b/tests/make.test.js @@ -52,7 +52,7 @@ describe("guida make warning flags", () => { const result = runMake(tmpobj.name, ["--no-warnings"]); expect(result.status).toBe(0); - expect(result.stderr).not.toMatch(/UNUSED IMPORT|UNUSED VARIABLE|MISSING TYPE ANNOTATION/); + expect(result.stderr).not.toMatch(/unused import|unused variable|missing type annotation/); expect(fs.existsSync(path.join(tmpobj.name, "warning-flags.js"))).toBe(true); }); @@ -62,9 +62,9 @@ describe("guida make warning flags", () => { const result = runMake(tmpobj.name, ["--deny-warnings"]); expect(result.status).toBe(1); - expect(result.stderr).toMatch(/UNUSED IMPORT/); - expect(result.stderr).toMatch(/UNUSED VARIABLE/); - expect(result.stderr).toMatch(/MISSING TYPE ANNOTATION/); + expect(result.stderr).toMatch(/unused import/); + expect(result.stderr).toMatch(/unused variable/); + expect(result.stderr).toMatch(/missing type annotation/); }); it("does not write output file with --deny-warnings", () => {