Check changeset tokens

check.fsx

#r "FSharp.Compiler.Service.dll"

open System
open System.Collections.Generic
open System.Diagnostics
open System.Globalization
open System.IO
open System.Text.RegularExpressions
open FSharp.Compiler.Tokenization
open Microsoft.FSharp.Core

let gitExe =
    let v = Environment.GetEnvironmentVariable("GIT_EXE")
    if String.IsNullOrEmpty v then "git" else v

let fileDiffHeaderRegex =
    Regex("^diff --git a/(.+) b/(.+)$", RegexOptions.ECMAScript)

let fileMatch line =
    let m = fileDiffHeaderRegex.Match line

    if m.Success then
        ValueSome(struct (m.Groups[1].Value, m.Groups[2].Value))
    else
        ValueNone

let toInt (s: ReadOnlySpan<char>) =
    Int32.Parse(s, CultureInfo.InvariantCulture)

let withDefault1 (c: Group) =
    if c.Success then toInt c.ValueSpan else 1

let hunkHeaderRegex =
    Regex("^@@ -(\d+)(?:,(\d+))? \+(\d+)(?:,(\d+))? @@", RegexOptions.ECMAScript)

let parseHunkHeader (line: string) =
    let m = hunkHeaderRegex.Match line

    if m.Success then
        ValueSome(struct (toInt m.Groups[1].ValueSpan, withDefault1 m.Groups[2], toInt m.Groups[3].ValueSpan, withDefault1 m.Groups[4]))
    else
        ValueNone

let rec fillRanges (getLine: unit -> string, ranges: List<struct (int * int * int * int)>) =
    let mutable line = getLine ()

    while line <> null
          && (line = "" // unexpected, but ok
              || line[0] = '+' // added
              || line[0] = '-' // removed
              || line[0] = '\\') do // \ No newline at end of file
        line <- getLine ()

    if line = null then
        null // EOF
    else
        match parseHunkHeader line with
        | ValueSome v ->
            ranges.Add(v)
            fillRanges (getLine, ranges)
        | ValueNone -> line // next hunk header

let rec checkLine (skipLine: bool, tokenizer: FSharpLineTokenizer, state) =
    let ti, state = tokenizer.ScanToken(state)

    match ti with
    | None -> state
    | Some ti ->
        if ti.TokenName = "HASH_IF" then
            printfn "File contains HASH_IF. Bailing out."
            exit 1
        else if
            skipLine
            || ti.Tag = FSharpTokenTag.WHITESPACE
            || ti.Tag = FSharpTokenTag.COMMENT
            || ti.Tag = FSharpTokenTag.LINE_COMMENT
        then
            checkLine (skipLine, tokenizer, state)
        else
            printfn $"Encountered %s{ti.TokenName} token in change set. Build required."
            exit 1

let rec checkFileRec (ranges: struct (int * int) list, getTokenizer: unit -> FSharpLineTokenizer, n: int, state) =
    match ranges with
    | [] -> ()
    | (rangeBegin, rangeEnd) :: remainingRanges ->
        if n < rangeEnd then
            let skip = n < rangeBegin
            let state = checkLine (skip, getTokenizer (), state)
            checkFileRec (ranges, getTokenizer, n + 1, state)
        else
            checkFileRec (remainingRanges, getTokenizer, n, state)

let checkFile (filename: string, source: TextReader, ranges: struct (int * int) list) =
    let tokenizer = FSharpSourceTokenizer([], Some filename, Some "PREVIEW", None)
    checkFileRec (ranges, (fun () -> tokenizer.CreateLineTokenizer(source.ReadLine())), 1, FSharpTokenizerLexState.Initial)

let isFSharpFile (filename: string) = // TODO
    filename.EndsWith(".fs", StringComparison.OrdinalIgnoreCase)
    || filename.EndsWith(".fsi", StringComparison.OrdinalIgnoreCase)
    || filename.EndsWith(".fsx", StringComparison.OrdinalIgnoreCase)
    || filename.EndsWith(".fsscript", StringComparison.OrdinalIgnoreCase)

let checkCurrent (filename: string) ranges =
    let list =
        [ for struct (_, _, c, co) in ranges do
              if co <> 0 then // offset = 0 - line deleted
                  struct (c, c + co) ]

    use source = new StreamReader(filename)
    checkFile (filename, source, list)

let checkPrevious rev (filename: string) ranges =
    let list =
        [ for struct (p, po, _, _) in ranges do
              if po <> 0 then // offset = 0 - line deleted
                  struct (p, p + po) ]

    use gitShow =
        Process.Start(ProcessStartInfo(gitExe, $"show \"%s{rev}:%s{filename}\"", RedirectStandardOutput = true, UseShellExecute = false))

    use source = gitShow.StandardOutput
    checkFile (filename, source, list)

let checkFilePair (status: bool voption) baseRev (struct (prev, curr)) ranges =
    if isFSharpFile prev || isFSharpFile curr then
        if (ValueOption.defaultValue true status) = true then
            checkCurrent curr ranges

        if (ValueOption.defaultValue false status) = false then
            checkPrevious baseRev prev ranges
    else
        printfn $"ignoring %s{curr}"

let main argv =
    let baseRev =
        match argv with
        | [| _; rev |] -> rev
        | _ ->
            eprintfn $"Usage: %s{argv[0]} <base_revision>"
            exit 2

    use gitDiff =
        Process.Start(ProcessStartInfo(gitExe, $"diff -U0 %s{baseRev}", RedirectStandardOutput = true, UseShellExecute = false))

    use input = gitDiff.StandardOutput
    let mutable inputLine = input.ReadLine()
    let ranges = List<struct (int * int * int * int)>()

    while inputLine <> null do

        let files =
            match fileMatch inputLine with
            | ValueNone ->
                eprintfn $"Unexpected input: %s{inputLine}"
                exit 2
            | ValueSome v -> v

        let status =
            match input.Peek() with
            | 110 (*'n'*)  -> // new file mode 100644
                input.ReadLine() |> ignore
                ValueSome true
            | 100 (*'d'*)  -> // deleted file mode 100644
                input.ReadLine() |> ignore
                ValueSome false
            | _ -> ValueNone

        input.ReadLine() |> ignore // index 939afb37e..acc2684b7 100644

        inputLine <- fillRanges (input.ReadLine, ranges)

        checkFilePair status baseRev files ranges
        ranges.Clear()

    exit 0

do main fsi.CommandLineArgs