open System
open System.Collections.Generic
open System.Diagnostics
open System.IO
open System.Reflection

exception UserError of string

type MutationCase =
    { Id: string
      File: string
      Line: int
      Find: string
      Replace: string
      TestName: string
      DeclaringType: string }

type MutationOutcome =
    | Killed
    | Survived
    | BuildFailed

type Command =
    | Validate
    | List
    | Show of string
    | Run of string list

type Options =
    { Configuration: string
      ProjectPath: string
      BuildArgs: string list
      NoBuild: bool
      Command: Command }

type ProjectInfo =
    { RelativeProjectPath: string
      AbsoluteProjectPath: string }

let fail message =
    raise (UserError message)

let runProcess (workingDirectory: string) (exe: string) (args: string list) =
    let psi = ProcessStartInfo()
    psi.FileName <- exe
    psi.WorkingDirectory <- workingDirectory
    psi.RedirectStandardOutput <- false
    psi.RedirectStandardError <- false
    psi.UseShellExecute <- false

    for arg in args do
        psi.ArgumentList.Add arg

    use proc = new Process()
    proc.StartInfo <- psi

    if not (proc.Start()) then
        failwithf "Failed to start %s" exe

    proc.WaitForExit()
    proc.ExitCode

let captureProcess (workingDirectory: string) (exe: string) (args: string list) =
    let psi = ProcessStartInfo()
    psi.FileName <- exe
    psi.WorkingDirectory <- workingDirectory
    psi.RedirectStandardOutput <- true
    psi.RedirectStandardError <- true
    psi.UseShellExecute <- false

    for arg in args do
        psi.ArgumentList.Add arg

    use proc = new Process()
    proc.StartInfo <- psi

    if not (proc.Start()) then
        failwithf "Failed to start %s" exe

    let stdout = proc.StandardOutput.ReadToEnd()
    let stderr = proc.StandardError.ReadToEnd()
    proc.WaitForExit()
    proc.ExitCode, stdout, stderr

let repoRoot =
    let exitCode, stdout, stderr =
        captureProcess Environment.CurrentDirectory "git" [ "rev-parse"; "--show-toplevel" ]

    if exitCode <> 0 then
        fail stderr

    stdout.Trim()

let parseArgs (args: string list) =
    let usage () =
        fail "Usage: mutannot <path/to/project.fsproj> [--configuration Debug|Release] [--build-arg <value> ...] [--no-build] [--validate | --list | --show <id> | --run [id...]]"

    let rec loop configuration projectPath buildArgs noBuild remaining =
        match remaining with
        | [] ->
            { Configuration = configuration
              ProjectPath = projectPath
              BuildArgs = List.rev buildArgs
              NoBuild = noBuild
              Command = Run [] }
        | "--configuration" :: value :: tail -> loop value projectPath buildArgs noBuild tail
        | "--build-arg" :: value :: tail -> loop configuration projectPath (value :: buildArgs) noBuild tail
        | "--no-build" :: tail -> loop configuration projectPath buildArgs true tail
        | "--validate" :: tail when tail.IsEmpty ->
            { Configuration = configuration
              ProjectPath = projectPath
              BuildArgs = List.rev buildArgs
              NoBuild = noBuild
              Command = Validate }
        | "--list" :: tail when tail.IsEmpty ->
            { Configuration = configuration
              ProjectPath = projectPath
              BuildArgs = List.rev buildArgs
              NoBuild = noBuild
              Command = List }
        | "--show" :: id :: tail when tail.IsEmpty ->
            { Configuration = configuration
              ProjectPath = projectPath
              BuildArgs = List.rev buildArgs
              NoBuild = noBuild
              Command = Show id }
        | "--run" :: tail ->
            { Configuration = configuration
              ProjectPath = projectPath
              BuildArgs = List.rev buildArgs
              NoBuild = noBuild
              Command = Run tail }
        | value :: tail when not (value.StartsWith "--") ->
            { Configuration = configuration
              ProjectPath = projectPath
              BuildArgs = List.rev buildArgs
              NoBuild = noBuild
              Command = Run (value :: tail) }
        | _ -> usage ()

    match args with
    | projectPath :: tail when not (projectPath.StartsWith "--") -> loop "Debug" projectPath [] false tail
    | _ -> usage ()

let ensureWithinRepo (path: string) =
    let relativePath = Path.GetRelativePath(repoRoot, path)

    if relativePath = ".." || relativePath.StartsWith($"..{Path.DirectorySeparatorChar}") then
        fail $"Project path must be inside the repository: {path}"

    relativePath

let loadProjectInfo (projectPath: string) =
    let absoluteProjectPath =
        if Path.IsPathRooted projectPath then
            projectPath
        else
            Path.GetFullPath(Path.Combine(Environment.CurrentDirectory, projectPath))

    if not (File.Exists absoluteProjectPath) then
        fail $"Project file not found: {absoluteProjectPath}"

    let relativeProjectPath = ensureWithinRepo absoluteProjectPath

    { RelativeProjectPath = relativeProjectPath
      AbsoluteProjectPath = absoluteProjectPath }

let targetPathForProject (workingDirectory: string) (projectPath: string) (configuration: string) =
    let exitCode, stdout, stderr =
        captureProcess
            workingDirectory
            "dotnet"
            [ "msbuild"
              projectPath
              "--getProperty:TargetPath"
              $"-property:Configuration={configuration}" ]

    if exitCode <> 0 then
        fail stderr

    let targetPath = stdout.Trim()

    if String.IsNullOrWhiteSpace targetPath then
        fail $"MSBuild did not return a TargetPath for {projectPath}."

    targetPath

let buildArgs configuration extraArgs projectPath =
    [ "build"; projectPath; "--configuration"; configuration; "--nologo" ] @ extraArgs

let ensureBuilt options project assemblyPath =
    if not options.NoBuild then
        let exitCode = runProcess repoRoot "dotnet" (buildArgs options.Configuration options.BuildArgs project.RelativeProjectPath)

        if exitCode <> 0 then
            fail "dotnet build failed."

    if not (File.Exists assemblyPath) then
        fail $"Compiled test assembly not found at {assemblyPath}."

let requireConstructorArgumentString (args: IList<CustomAttributeTypedArgument>) index name =
    match args[index].Value with
    | :? string as value when not (isNull value) -> value
    | null -> fail $"MutationCaseAttribute constructor argument '{name}' must not be null."
    | value ->
        fail
            $"MutationCaseAttribute constructor argument '{name}' had unexpected type '{value.GetType().FullName}'."

let requireConstructorArgumentInt32 (args: IList<CustomAttributeTypedArgument>) index name =
    match args[index].Value with
    | :? int as value -> value
    | null -> fail $"MutationCaseAttribute constructor argument '{name}' must not be null."
    | value ->
        fail
            $"MutationCaseAttribute constructor argument '{name}' had unexpected type '{value.GetType().FullName}'."

let metadataLoadContextPaths (assemblyPath: string) =
    let assemblyDir = Path.GetDirectoryName assemblyPath

    let runtimeAssemblies =
        match AppContext.GetData "TRUSTED_PLATFORM_ASSEMBLIES" with
        | :? string as value when not (String.IsNullOrWhiteSpace value) ->
            value.Split(Path.PathSeparator, StringSplitOptions.RemoveEmptyEntries)
        | _ -> fail "Unable to discover trusted platform assemblies for MetadataLoadContext."

    let localAssemblies =
        seq {
            yield assemblyPath
            yield! Directory.EnumerateFiles(assemblyDir, "*.dll")
            yield! Directory.EnumerateFiles(assemblyDir, "*.exe")
        }

    Seq.append runtimeAssemblies localAssemblies
    |> Seq.distinct
    |> Seq.toArray

let createMetadataLoadContext (assemblyPath: string) =
    let resolver = PathAssemblyResolver(metadataLoadContextPaths assemblyPath)
    let coreAssemblyName = typeof<obj>.Assembly.GetName().Name

    new MetadataLoadContext(resolver, coreAssemblyName)

let mutationCases options project assemblyPath =
    ensureBuilt options project assemblyPath

    use mlc = createMetadataLoadContext assemblyPath
    let asm = mlc.LoadFromAssemblyPath assemblyPath

    asm.GetTypes()
    |> Array.collect (fun t ->
        let declaringType =
            match t.FullName with
            | null -> t.Name
            | name -> name

        t.GetMethods(BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Static ||| BindingFlags.Instance)
        |> Array.collect (fun m ->
            m.GetCustomAttributesData()
            |> Seq.choose (fun attr ->
                if attr.AttributeType.FullName <> "Mutannot.MutationCaseAttribute" then
                    None
                else
                    let args = attr.ConstructorArguments

                    if args.Count <> 5 then
                        fail $"Unexpected MutationCaseAttribute shape on {declaringType}.{m.Name}"

                    Some
                        { Id = requireConstructorArgumentString args 0 "id"
                          File = requireConstructorArgumentString args 1 "file"
                          Line = requireConstructorArgumentInt32 args 2 "line"
                          Find = requireConstructorArgumentString args 3 "find"
                          Replace = requireConstructorArgumentString args 4 "replace"
                          TestName = m.Name
                          DeclaringType = declaringType })
            |> Seq.toArray))
    |> Array.sortBy (fun mutation -> mutation.Id)

let findMutation id mutations =
    mutations
    |> Array.tryFind (fun mutation -> mutation.Id = id)
    |> Option.defaultWith (fun () -> fail $"Unknown mutation id: {id}")

let lineSpan (filePath: string) (text: string) (lineNumber: int) =
    if lineNumber < 1 then
        fail $"Line number must be positive: {lineNumber}"

    let mutable currentLine = 1
    let mutable lineStart = 0
    let mutable index = 0

    while index < text.Length && currentLine < lineNumber do
        if text[index] = '\n' then
            currentLine <- currentLine + 1
            lineStart <- index + 1

        index <- index + 1

    if currentLine <> lineNumber then
        fail $"Line {lineNumber} does not exist in {filePath}"

    let mutable lineEnd = lineStart

    while lineEnd < text.Length && text[lineEnd] <> '\n' && text[lineEnd] <> '\r' do
        lineEnd <- lineEnd + 1

    lineStart, lineEnd

let replaceOccurrenceOnLine (mutation: MutationCase) (text: string) =
    let lineStart, lineEnd = lineSpan mutation.File text mutation.Line
    let lineText = text.Substring(lineStart, lineEnd - lineStart)
    let lineOffset = lineText.IndexOf(mutation.Find, StringComparison.Ordinal)

    if lineOffset < 0 then
        fail $"Line {mutation.Line} in {mutation.File} does not contain '{mutation.Find}'."

    let absoluteOffset = lineStart + lineOffset
    text.Remove(absoluteOffset, mutation.Find.Length).Insert(absoluteOffset, mutation.Replace)

let countOccurrencesOnLine (needle: string) (lineText: string) =
    if String.IsNullOrEmpty needle then
        0
    else
        let mutable count = 0
        let mutable startIndex = 0
        let mutable keepSearching = true

        while keepSearching do
            let index = lineText.IndexOf(needle, startIndex, StringComparison.Ordinal)

            if index < 0 then
                keepSearching <- false
            else
                count <- count + 1
                startIndex <- index + needle.Length

        count

let trimLineForDisplay (lineText: string) =
    let trimmed = lineText.Trim()

    if String.IsNullOrEmpty trimmed then
        "<empty line>"
    else
        trimmed

let staleMutationMessage (mutation: MutationCase) (detail: string) =
    $"Mutation '{mutation.Id}' is stale: the recorded target at {mutation.File}:{mutation.Line} no longer matches the current source. {detail} Re-locate the intended mutation and update its file/line/find metadata."

let validateMutation (repoRoot: string) (mutation: MutationCase) =
    let targetFile = Path.Combine(repoRoot, mutation.File.Replace('/', Path.DirectorySeparatorChar))

    if String.IsNullOrEmpty mutation.Find then
        Some(staleMutationMessage mutation "The recorded find text is empty.")
    elif not (File.Exists targetFile) then
        Some(staleMutationMessage mutation $"The target file '{mutation.File}' no longer exists.")
    else
        let originalText = File.ReadAllText targetFile

        try
            let lineStart, lineEnd = lineSpan mutation.File originalText mutation.Line
            let lineText = originalText.Substring(lineStart, lineEnd - lineStart)
            let occurrenceCount = countOccurrencesOnLine mutation.Find lineText

            match occurrenceCount with
            | 0 ->
                Some
                    (staleMutationMessage
                        mutation
                        $"Expected to find '{mutation.Find}' on that line, but it has changed to '{trimLineForDisplay lineText}'.")
            | 1 -> None
            | count ->
                Some
                    (staleMutationMessage
                        mutation
                        $"The text '{mutation.Find}' now appears {count} times on that line, so the recorded target is no longer unique. Current line: '{trimLineForDisplay lineText}'.")
        with
        | UserError message -> Some(staleMutationMessage mutation message)

let printValidationErrors errors =
    eprintfn "Validation failed for %d mutation(s):" (errors |> List.length)

    for mutation, message in errors do
        eprintfn "[%s] %s:%d %s" mutation.Id mutation.File mutation.Line message

let collectValidationErrors repoRoot mutations =
    mutations
    |> List.choose (fun mutation -> validateMutation repoRoot mutation |> Option.map (fun message -> mutation, message))

let printMutation mutation =
    printfn "id: %s" mutation.Id
    printfn "test: %s.%s" mutation.DeclaringType mutation.TestName
    printfn "file: %s:%d" mutation.File mutation.Line
    printfn "find: %s" mutation.Find
    printfn "replace: %s" mutation.Replace

let splitNullSeparated (text: string) =
    text.Split('\000', StringSplitOptions.RemoveEmptyEntries) |> Array.toList

let repoRelativePath (path: string) =
    path.Replace('/', Path.DirectorySeparatorChar)

let listUntrackedFiles () =
    let exitCode, stdout, stderr =
        captureProcess repoRoot "git" [ "ls-files"; "--others"; "--exclude-standard"; "-z" ]

    if exitCode <> 0 then
        fail stderr

    splitNullSeparated stdout

let copyFileIntoWorktree (repoRoot: string) (worktreePath: string) (relativePath: string) =
    let sourcePath = Path.Combine(repoRoot, repoRelativePath relativePath)
    let destinationPath = Path.Combine(worktreePath, repoRelativePath relativePath)
    let destinationDir = Path.GetDirectoryName destinationPath

    if not (String.IsNullOrEmpty destinationDir) then
        Directory.CreateDirectory(destinationDir) |> ignore

    File.Copy(sourcePath, destinationPath, true)

let cleanup (tempRoot: string) (worktreePath: string) =
    if Directory.Exists worktreePath then
        let _ = captureProcess repoRoot "git" [ "worktree"; "remove"; "--force"; worktreePath ]
        ()

    if Directory.Exists tempRoot then
        Directory.Delete(tempRoot, true)

let createWorktree (patchPath: string) (worktreePath: string) =
    let tempRoot = Path.GetDirectoryName patchPath
    Directory.CreateDirectory(tempRoot) |> ignore

    let untrackedFiles = listUntrackedFiles ()
    let exitCode, diffText, stderr = captureProcess repoRoot "git" [ "diff"; "--binary"; "HEAD" ]

    if exitCode <> 0 then
        fail stderr

    File.WriteAllText(patchPath, diffText)

    let exitCode2, stdout2, stderr2 = captureProcess repoRoot "git" [ "rev-parse"; "HEAD" ]

    if exitCode2 <> 0 then
        fail stderr2

    let baseRev = stdout2.Trim()
    let exitCode3, _, stderr3 = captureProcess repoRoot "git" [ "worktree"; "add"; "--detach"; worktreePath; baseRev ]

    if exitCode3 <> 0 then
        fail stderr3

    if FileInfo(patchPath).Length > 0L then
        let exitCode4, _, stderr4 = captureProcess worktreePath "git" [ "apply"; patchPath ]

        if exitCode4 <> 0 then
            fail stderr4

    for relativePath in untrackedFiles do
        copyFileIntoWorktree repoRoot worktreePath relativePath

let fullyQualifiedTestName mutation =
    let declaringType = mutation.DeclaringType.Replace('+', '.')
    $"{declaringType}.{mutation.TestName}"

let testFilter mutation =
    $"FullyQualifiedName={fullyQualifiedTestName mutation}"

let runMutation options project worktreePath mutation =
    let targetFile = Path.Combine(worktreePath, mutation.File.Replace('/', Path.DirectorySeparatorChar))

    if not (File.Exists targetFile) then
        fail $"Target file does not exist in worktree: {targetFile}"

    let originalText = File.ReadAllText targetFile
    let mutatedText = replaceOccurrenceOnLine mutation originalText
    File.WriteAllText(targetFile, mutatedText)

    printfn "==> %s: %s" mutation.Id mutation.TestName

    let buildExitCode =
        runProcess worktreePath "dotnet" (buildArgs options.Configuration options.BuildArgs project.RelativeProjectPath)

    let outcome =
        if buildExitCode <> 0 then
            printfn "BUILD FAILED %s" mutation.Id
            BuildFailed
        else
            let testExitCode =
                runProcess
                    worktreePath
                    "dotnet"
                    [ "test"
                      project.RelativeProjectPath
                      "--configuration"
                      options.Configuration
                      "--filter"
                      testFilter mutation
                      "--no-build"
                      "--nologo" ]

            if testExitCode = 0 then
                printfn "SURVIVED  %s" mutation.Id
                Survived
            else
                printfn "KILLED    %s" mutation.Id
                Killed

    File.WriteAllText(targetFile, originalText)
    outcome

[<EntryPoint>]
let main argv =
    try
        let options = parseArgs (argv |> Array.toList)
        let project = loadProjectInfo options.ProjectPath
        let assemblyPath = targetPathForProject repoRoot project.AbsoluteProjectPath options.Configuration
        let mutations = mutationCases options project assemblyPath

        if Array.isEmpty mutations then
            fail "No mutation cases were discovered in the test assembly."

        match options.Command with
        | Validate ->
            let validationErrors = mutations |> Array.toList |> collectValidationErrors repoRoot

            if validationErrors.IsEmpty then
                printfn "Validated %d mutation(s): all still apply syntactically." mutations.Length
                0
            else
                printValidationErrors validationErrors
                1
        | List ->
            mutations
            |> Array.iter (fun mutation ->
                printfn "%s\t%s\t%s:%d" mutation.Id mutation.TestName mutation.File mutation.Line)

            0
        | Show id ->
            let mutation = findMutation id mutations
            printMutation mutation
            0
        | Run ids ->
            let requested =
                match ids with
                | [] -> mutations |> Array.toList
                | _ -> ids |> List.map (fun id -> findMutation id mutations)

            let validationErrors = collectValidationErrors repoRoot requested

            if not validationErrors.IsEmpty then
                printValidationErrors validationErrors
                1
            else

                let tempRoot = Path.Combine(Path.GetTempPath(), $"fscheck-mutants.{Guid.NewGuid():N}")
                let worktreePath = Path.Combine(tempRoot, "worktree")
                let patchPath = Path.Combine(tempRoot, "current.patch")

                try
                    createWorktree patchPath worktreePath

                    let outcomes =
                        requested |> List.map (runMutation options project worktreePath)

                    let survivors = outcomes |> List.filter ((=) Survived) |> List.length
                    let buildFailures = outcomes |> List.filter ((=) BuildFailed) |> List.length

                    if survivors = 0 && buildFailures = 0 then
                        printfn "All requested mutants were killed."
                        0
                    else
                        fail $"{survivors} mutant(s) survived. {buildFailures} mutant(s) failed to build."
                finally
                    cleanup tempRoot worktreePath
    with
    | UserError message ->
        eprintfn "%s" message
        1