Run the F# analyzers over every project and script

.config/dotnet-tools.json

@@ -22,6 +22,13 @@
         "fsdocs"
       ],
       "rollForward": false
+    },
+    "fsharp-analyzers": {
+      "version": "0.39.2",
+      "commands": [
+        "fsharp-analyzers"
+      ],
+      "rollForward": false
     }
   }
 }

.github/workflows/pull-requests.yml

@@ -5,6 +5,10 @@ on:
     branches:
     - master
 
+permissions:
+  contents: read
+  security-events: write
+
 jobs:
   build:
 
@@ -24,3 +28,22 @@ jobs:
       run: dotnet paket restore
     - name: Build
       run: dotnet fsi build.fsx
+
+  analyze:
+    runs-on: ubuntu-latest
+
+    steps:
+    - uses: actions/checkout@v7
+    - name: Setup .NET
+      uses: actions/setup-dotnet@v6
+    - name: Install local tools
+      run: dotnet tool restore
+    - name: Paket restore
+      run: dotnet paket restore
+    - name: Analyze
+      run: dotnet fsi build.fsx -p Analyze
+      continue-on-error: true
+    - name: Upload SARIF file
+      uses: github/codeql-action/upload-sarif@v4
+      with:
+        sarif_file: ./analysis.sarif

.github/workflows/push-main.yml

@@ -9,6 +9,7 @@ permissions:
   contents: read
   pages: write
   id-token: write
+  security-events: write
 
 jobs:
   build:
@@ -31,6 +32,15 @@ jobs:
       run: dotnet fsi build.fsx -p Release
     - name: Publish NuGets (if main version changed)
       run: dotnet nuget push "bin/*.nupkg" -s https://api.nuget.org/v3/index.json -k ${{ secrets.NUGET_KEY }} --skip-duplicate
+    # A baseline on the default branch, so code scanning can tell a pull request's new findings
+    # from the ones it inherited.
+    - name: Analyze
+      run: dotnet fsi build.fsx -p Analyze
+      continue-on-error: true
+    - name: Upload SARIF file
+      uses: github/codeql-action/upload-sarif@v4
+      with:
+        sarif_file: ./analysis.sarif
     - name: Build documentation
       run: dotnet fsi build.fsx -p Docs
     - name: Upload documentation

.gitignore

@@ -233,3 +233,6 @@ tests/fsyacc/repro_#141/Lexer_fail_option_i.fs
 tests/fsyacc/repro_#141/Lexer_fail_option_i.fsi
 tests/fsyacc/repro1885/repro1885.fs
 tests/fsyacc/repro1885/repro1885.fsi
+
+# Written by the Analyze pipeline in build.fsx
+analysis.sarif

build.fsx

@@ -40,7 +40,8 @@ type Release =
 /// An entry is a "#### <version> - <date>" heading followed by "* " bullets, and the date is
 /// allowed to read "Unreleased" while the version is still in flight.
 let release: Release =
-    let isHeading (line: string) = line.StartsWith "####"
+    let isHeading (line: string) =
+        line.StartsWith("####", StringComparison.Ordinal)
 
     let lines = File.ReadAllLines(root </> "RELEASE_NOTES.md")
     let headingIndex = Array.findIndex isHeading lines
@@ -112,19 +113,19 @@ let writeAssemblyInfo (project: string) (product: string) =
             "namespace System"
             "open System.Reflection"
             ""
-            $"[<assembly: AssemblyTitleAttribute(\"{project}\")>]"
-            $"[<assembly: AssemblyProductAttribute(\"{product}\")>]"
-            $"[<assembly: AssemblyDescriptionAttribute(\"{summary}\")>]"
-            $"[<assembly: AssemblyVersionAttribute(\"{version}\")>]"
-            $"[<assembly: AssemblyFileVersionAttribute(\"{version}\")>]"
+            $"[<assembly: AssemblyTitleAttribute(\"%s{project}\")>]"
+            $"[<assembly: AssemblyProductAttribute(\"%s{product}\")>]"
+            $"[<assembly: AssemblyDescriptionAttribute(\"%s{summary}\")>]"
+            $"[<assembly: AssemblyVersionAttribute(\"%s{version}\")>]"
+            $"[<assembly: AssemblyFileVersionAttribute(\"%s{version}\")>]"
             "do ()"
             ""
             "module internal AssemblyVersionInformation ="
-            $"    let [<Literal>] AssemblyTitle = \"{project}\""
-            $"    let [<Literal>] AssemblyProduct = \"{product}\""
-            $"    let [<Literal>] AssemblyDescription = \"{summary}\""
-            $"    let [<Literal>] AssemblyVersion = \"{version}\""
-            $"    let [<Literal>] AssemblyFileVersion = \"{version}\""
+            $"    let [<Literal>] AssemblyTitle = \"%s{project}\""
+            $"    let [<Literal>] AssemblyProduct = \"%s{product}\""
+            $"    let [<Literal>] AssemblyDescription = \"%s{summary}\""
+            $"    let [<Literal>] AssemblyVersion = \"%s{version}\""
+            $"    let [<Literal>] AssemblyFileVersion = \"%s{version}\""
             ""
         ]
         |> String.concat Environment.NewLine
@@ -211,6 +212,25 @@ let buildLibraries =
 // Packaging
 // --------------------------------------------------------------------------------------
 
+/// Escape a value for a `/p:Name=value` switch.
+///
+/// MSBuild reads a newline, `;` or `,` in a property value as the start of the next switch, and
+/// treats `$`, `%` and friends as its own syntax. Each becomes its `%XX` escape, which MSBuild
+/// unescapes again when it reads the property, so the release notes arrive as written.
+let msbuildEscape (value: string) =
+    let special =
+        Collections.Generic.HashSet [ '%'; '$'; '@'; '\''; ';'; ','; '?'; '*'; '('; ')'; '\r'; '\n' ]
+
+    let escaped = Text.StringBuilder()
+
+    for c in value do
+        if special.Contains c then
+            escaped.Append('%').Append((int c).ToString "X2") |> ignore
+        else
+            escaped.Append c |> ignore
+
+    escaped.ToString()
+
 let pack =
     async {
         let releaseNotes = String.concat Environment.NewLine release.Notes
@@ -226,8 +246,8 @@ let pack =
                     "Release"
                     "-o"
                     "bin"
-                    $"/p:PackageReleaseNotes={releaseNotes}"
-                    $"/p:PackageVersion={release.NugetVersion}"
+                    $"/p:PackageReleaseNotes=%s{msbuildEscape releaseNotes}"
+                    $"/p:PackageVersion=%s{release.NugetVersion}"
                 ]
 
         if projectPackages <> 0 then
@@ -251,6 +271,79 @@ let pack =
                     ]
     }
 
+// --------------------------------------------------------------------------------------
+// Analyzers
+// --------------------------------------------------------------------------------------
+
+/// Every project in the solution. Reading the solution rather than globbing keeps the fixtures
+/// under tests/fsyacc out, which are inputs to OldFsYaccTests.fsx rather than code of their own.
+let projectsToAnalyze: string list =
+    File.ReadAllLines(root </> "FsLexYacc.slnx")
+    |> Array.choose (fun line ->
+        let m = Text.RegularExpressions.Regex.Match(line, "<Project Path=\"([^\"]+)\"")
+        if m.Success then Some m.Groups.[1].Value else None)
+    |> Array.toList
+
+/// The scripts the analyzers run over: the only F# in this repository no project compiles.
+let scriptsToAnalyze: string list =
+    [ "build.fsx"; "tests/fsyacc/OldFsYaccTests.fsx" ]
+
+/// Restored by paket into the Analyzers group, see paket.dependencies.
+let analyzerPaths: string list =
+    [ "Ionide.Analyzers"; "G-Research.FSharp.Analyzers" ]
+    |> List.map (fun package ->
+        root
+        </> "packages"
+        </> "analyzers"
+        </> package
+        </> "analyzers"
+        </> "dotnet"
+        </> "fs")
+
+let analysisReport = root </> "analysis.sarif"
+
+/// One run over every project and script, so a single SARIF covers the repository.
+///
+/// The tool only exits non-zero for error-severity findings, so a run full of warnings still
+/// passes; the findings are read from the report, or from the Code Scanning tab in CI.
+let analyze =
+    async {
+        let! _ = deleteFiles [ "analysis.sarif" ]
+
+        return!
+            exec
+                "dotnet"
+                [
+                    "fsharp-analyzers"
+                    for path in analyzerPaths do
+                        "--analyzers-path"
+                        path
+                    for project in projectsToAnalyze do
+                        "--project"
+                        root </> project
+                    for script in scriptsToAnalyze do
+                        "--script"
+                        root </> script
+                    // Not ours to fix: what fslex and fsyacc generate, what this script generates,
+                    // the test SDK entry point, and the scripts NuGet writes per `#r "nuget: ..."`.
+                    "--exclude-files"
+                    // Globs, because the tool matches these against absolute paths.
+                    for generated in generatedSources @ generatedTestSources do
+                        "**/" + Path.GetFileName generated
+                    "**/AssemblyInfo.fs"
+                    "**/Microsoft.NET.Test.Sdk.Program.fs"
+                    "**/.packagemanagement/**"
+                    "--configuration"
+                    "Release"
+                    // With a trailing separator, or the tool reads the last segment as a file name
+                    // and reports every path as "FsLexYacc/...", which GitHub cannot link.
+                    "--code-root"
+                    root + Path.DirectorySeparatorChar.ToString()
+                    "--report"
+                    analysisReport
+                ]
+    }
+
 // --------------------------------------------------------------------------------------
 // Pipelines
 // --------------------------------------------------------------------------------------
@@ -301,4 +394,16 @@ pipeline "Docs" {
     runIfOnlySpecified true
 }
 
+// The generated sources have to exist before a project can be type checked, so the tools and
+// libraries are built first, the same way the Build pipeline does.
+pipeline "Analyze" {
+    workingDir root
+    restore
+    stage "AssemblyInfo" { run generateAssemblyInfo }
+    stage "BuildTools" { run buildTools }
+    stage "BuildLibraries" { run buildLibraries }
+    stage "Analyze" { run analyze }
+    runIfOnlySpecified true
+}
+
 tryPrintPipelineCommandHelp ()

paket.dependencies

@@ -9,4 +9,14 @@ nuget Microsoft.SourceLink.GitHub copy_local: true
 nuget Expecto ~> 9.0
 nuget Expecto.FsCheck
 nuget Microsoft.NET.Test.Sdk
-nuget YoloDev.Expecto.TestSdk
+nuget YoloDev.Expecto.TestSdk
+
+// Only the Analyze pipeline in build.fsx uses these, so they live in their own group and no
+// project references them. A fixed on-disk location, rather than the NuGet cache, so the script
+// can point fsharp-analyzers at them without knowing the version.
+group Analyzers
+  source https://api.nuget.org/v3/index.json
+  storage: packages
+
+  nuget Ionide.Analyzers 0.19.0
+  nuget G-Research.FSharp.Analyzers 0.25.0

paket.lock

@@ -37,3 +37,10 @@ NUGET
       Expecto (>= 9.0 < 10.0) - restriction: || (== net10.0) (&& (== netstandard2.0) (>= netcoreapp3.1))
       FSharp.Core (>= 4.6.2) - restriction: || (== net10.0) (&& (== netstandard2.0) (>= netcoreapp3.1))
       System.Collections.Immutable (>= 6.0) - restriction: || (== net10.0) (&& (== netstandard2.0) (>= netcoreapp3.1))
+
+GROUP Analyzers
+STORAGE: PACKAGES
+NUGET
+  remote: https://api.nuget.org/v3/index.json
+    G-Research.FSharp.Analyzers (0.25)
+    Ionide.Analyzers (0.19)

src/Common/Arg.fs

@@ -79,7 +79,7 @@ type ArgParser() =
         pendline "display this list of options"
         sbuf.ToString()
 
-    static member ParsePartial(cursor: ref<int>, argv, arguments: seq<ArgInfo>, ?otherArgs, ?usageText) =
+    static member ParsePartial(cursor: int ref, argv, arguments: ArgInfo seq, ?otherArgs, ?usageText) =
         let other = defaultArg otherArgs (fun _ -> ())
         let usageText = defaultArg usageText ""
         let nargs = Array.length argv

src/Common/Arg.fsi

@@ -32,15 +32,15 @@ type ArgParser =
     /// Parse some of the arguments given by 'argv', starting at the given position
     [<System.Obsolete("This method should not be used directly as it will be removed in a future revision of this library")>]
     static member ParsePartial:
-        cursor: int ref * argv: string[] * arguments: seq<ArgInfo> * ?otherArgs: (string -> unit) * ?usageText: string -> unit
+        cursor: int ref * argv: string array * arguments: ArgInfo seq * ?otherArgs: (string -> unit) * ?usageText: string -> unit
 
     /// Parse the arguments given by System.Environment.GetCommandLineArgs()
     /// according to the argument processing specifications "specs".
     /// Args begin with "-". Non-arguments are passed to "f" in
     /// order.  "use" is printed as part of the usage line if an error occurs.
 
-    static member Parse: arguments: seq<ArgInfo> * ?otherArgs: (string -> unit) * ?usageText: string -> unit
+    static member Parse: arguments: ArgInfo seq * ?otherArgs: (string -> unit) * ?usageText: string -> unit
 #endif
 
     /// Prints the help for each argument.
-    static member Usage: arguments: seq<ArgInfo> * ?usage: string -> unit
+    static member Usage: arguments: ArgInfo seq * ?usage: string -> unit

src/FsLex.Core/fslexast.fs

@@ -70,15 +70,16 @@ let EncodeUnicodeCategory s : Parser<uint32> =
         else
             failwithf "invalid Unicode category: '%s'" s
 
-let TryDecodeUnicodeCategory (x: Alphabet) : UnicodeCategory option =
+let TryDecodeUnicodeCategory (x: Alphabet) : UnicodeCategory voption =
     let maybeUnicodeCategory =
         x - encodedUnicodeCategoryBase |> int32 |> enum<UnicodeCategory>
 
     if UnicodeCategory.IsDefined(typeof<UnicodeCategory>, maybeUnicodeCategory) then
-        Some maybeUnicodeCategory
+        ValueSome maybeUnicodeCategory
     else
-        None
+        ValueNone
 
+[<return: Struct>]
 let (|UnicodeCategoryAP|_|) (x: Alphabet) = TryDecodeUnicodeCategory x
 
 let IsUnicodeCategory (x: Alphabet) =
@@ -249,7 +250,7 @@ type NfaNodeMap() =
         let node: NfaNode =
             {
                 Id = nodeId
-                Name = string nodeId
+                Name = string<int> nodeId
                 Transitions = trDict
                 Accepted = ac
             }
@@ -282,7 +283,7 @@ let LexerStateToNfa ctx (macros: Map<string, _>) (clauses: Clause list) =
                         UnicodeCategory.TitlecaseLetter
                     ]
 
-                let isCasedLetterCategory = allCasedCategories |> Seq.contains uc
+                let isCasedLetterCategory = allCasedCategories |> List.contains uc
 
                 if isCasedLetterCategory then
                     let trs =
@@ -446,7 +447,7 @@ let NfaToDfa (nfaNodeMap: NfaNodeMap) nfaStartNode =
                     //printfn "n.Id = %A, #Epsilon = %d" n.Id tr.Length
                     tr |> List.iter (EClosure1 acc)
 
-    let EClosure (moves: list<NodeId>) =
+    let EClosure (moves: NodeId list) =
         let acc = NfaNodeIdSetBuilder(HashIdentity.Structural)
 
         for i in moves do

src/FsLex.Core/fslexdriver.fs

@@ -6,6 +6,7 @@ open System.IO
 open FSharp.Text.Lexing
 open System.Collections.Generic
 
+[<Struct>]
 type Domain =
     | Unicode
     | ASCII
@@ -24,8 +25,8 @@ type GeneratorState =
         domain: Domain
     }
 
-type PerRuleData = list<DfaNode * seq<Code>>
-type DfaNodes = list<DfaNode>
+type PerRuleData = (DfaNode * Code seq) list
+type DfaNodes = DfaNode list
 
 type Writer(outputFileName, outputFileInterface) =
     let os = File.CreateText outputFileName :> TextWriter

src/FsLex/fslex.fs

@@ -91,11 +91,11 @@ let main () =
 
                 exit 1
 
-        printfn "compiling to dfas (can take a while...)"
+        stdout.WriteLine "compiling to dfas (can take a while...)"
         let perRuleData, dfaNodes = compileSpec spec parseContext
         printfn "%d states" dfaNodes.Length
 
-        printfn "writing output"
+        stdout.WriteLine "writing output"
 
         let output =
             match out with