#!/usr/bin/env -S dotnet fsi
#r "nuget: Argu, 6.2.5"
#r "nuget: Tommy, 3.1.2"
open Argu
open System
open System.IO
open Tommy
open System.Diagnostics
open System.Threading.Tasks

type Argument =
    | [<Mandatory; AltCommandLine("-i")>] Inputs of input: string list
    | [<Mandatory; AltCommandLine("-t")>] Texts of text: string list
    | [<Mandatory; Unique; AltCommandLine("-o")>] Output of output: string
    | [<Unique; AltCommandLine("-c")>] Config of config: string
    | [<Unique; AltCommandLine("-f")>] Format of format: string

    interface IArgParserTemplate with
        member s.Usage : string = 
            match s with
            | Inputs _ -> "input images"
            | Texts _ -> "texts to apply to input images"
            | Output _ -> "directory to place output images"
            | Config _ -> "configuration file location (default: config.toml)"
            | Format _ -> "output image format (file extension; by default reuse format of input image)"

type TextOption =
    | Font of string
    | FontSize of uint
    | MaxWidth of uint
    | Color of string
    | Background of string

let generateImage
    (input : string)
    (text : string)
    (options : TextOption list)
    (output : string)
    =
    let args = 
        [ input ]
        @ (options
            |> List.map (fun o ->
                match o with
                | Font font -> "font", font
                | FontSize ps -> "pointsize", string(ps)
                | MaxWidth w -> "size", string(w)
                | Color color -> "fill", color
                | Background bg -> "undercolor", bg
            )
            |> List.map (fun (param, value) -> [ sprintf "-%s" param; value ])
            |> List.concat)
        @ [ "-background"; "transparent" ]
        @ [ "-gravity"; "center" ]
        @ [ "caption:@-" ]
        @ [ "-composite" ]
        @ [ output ]
    printf "%s" (sprintf "magick %s\n" (args |> String.concat " ")) // There's a race for stdout
    let startInfo =
        ProcessStartInfo("magick", args,
            RedirectStandardInput = true,
            UseShellExecute = false,
            CreateNoWindow = true
        )
    use p = Process.Start(startInfo)

    text.Split('\n')
    |> Array.map (fun s ->
        match s.Trim() with
        | "" -> ""
        | s -> " " + s + " "
    )
    |> fun parts -> String.Join('\n', parts)
    |> p.StandardInput.Write
    p.StandardInput.Close()
    p.WaitForExit()

let parser = ArgumentParser.Create<Argument>()
let results = 
    try
        parser.ParseCommandLine(Environment.GetCommandLineArgs() |> Array.skip 2)
    with
        | :? ArguParseException as exn ->
            printfn "%s" exn.Message
            exit 1

let inputs =
    results.GetResults(Inputs)
    |> List.reduce (fun a b -> List.append a b)

let texts =
    results.GetResults(Texts)
    |> List.reduce (fun a b -> List.append a b)

let output = results.GetResult(Output)

let configFile = results.TryGetResult(Config) |> Option.defaultValue "config.toml"

let format = results.TryGetResult(Format)

let readConfig file : TextOption list * Map<string, TextOption list> =
    let parseSection (defaults : Map<string, TextOption> option) (table : TomlTable) : Map<string, TextOption> * string list =
        let values = defaultArg defaults (Map [])

        ((values, []), table.RawTable |> Seq.filter (fun kvp -> not kvp.Value.IsTable))
        ||> Seq.fold (fun (values, errors) kvp ->
            let key, value = kvp.Key, kvp.Value

            let str f =
                if value.IsString then
                    values.Add(key, (f value.AsString.Value)), errors
                else
                    values, [ sprintf "'%s' must be string" key ] @ errors
            let uint f =
                if value.IsInteger then
                    let i = value.AsInteger.Value
                    if i >= 0 then
                        values.Add(key, f ((uint)i)), errors
                    else
                        values, [ sprintf "'%s' must be positive integer" key ] @ errors
                else
                    values, [ sprintf "'%s' must be positive integer" key ] @ errors

            let key = kvp.Key
            match key with
            | "font" -> str (fun s -> Font s)
            | "font_size" -> uint (fun i -> FontSize i)
            | "max_width" -> uint (fun i -> MaxWidth i)
            | "color" -> str (fun s -> Color s)
            | "background" -> str (fun s -> Background s)
            | k -> values, [ sprintf "unrecognized key '%s'" k ] @ errors
        )

    let convert (s : Map<string, TextOption>) : TextOption list =
        s
        |> Seq.map (fun x -> x.Value)
        |> Seq.rev
        |> List.ofSeq

    let toml =
        try
            use reader = File.OpenText(file)
            TOML.Parse(reader)
        with
            | :? FileNotFoundException ->
                printfn "config file %s not found" file
                exit 1
            | :? TomlParseException as ex ->
                for se in ex.SyntaxErrors do
                    printfn "%s:%d:%d: %s" file se.Line se.Column se.Message
                exit 1

    let def : Map<string, TextOption> =
        match parseSection None toml with
        | def, [] -> def
        | _, errors ->
            for error in errors do
                printfn "%s: failed to parse default configuration: %s" file error
            exit 1

    let images =
        (([], []), toml.RawTable |> Seq.filter (fun kvp -> kvp.Value.IsTable))
        ||> Seq.fold (fun state kvp ->
            match parseSection (Some def) kvp.Value.AsTable with
            | values, [] -> [ (kvp.Key, values) ] @ fst state, snd state
            | _, errors -> fst state, [ (kvp.Key, errors) ] @ snd state
        )
        |> function
            | images, [] ->
                Seq.map (fun (section, values) -> section, convert values) images |> Map
            | _, errors ->
                for (section, errors) in errors do
                    for error in errors do
                        printfn "%s: failed to parse section %s: %s" file section error
                exit 1

    convert def, images

let defaultConfig, imageConfigs = readConfig configFile

match List.filter (fun i -> not (File.Exists i)) inputs with
| [] -> ()
| notFound ->
    for f in notFound do
        printfn "input file '%s' not found" f
    exit 1

match List.filter (fun t -> not (File.Exists t)) texts with
| [] -> ()
| notFound ->
    for f in notFound do
        printfn "text source '%s' not found" f
    exit 1

try
    Directory.CreateDirectory(output) |> ignore
with
    | ex ->
        printfn "failed to create output directory '%s': %s" output ex.Message
        exit 1

let taggedTexts =
    texts
    |> List.map (fun t ->
        Path.GetFileName(t), File.ReadAllText(t)
    )

Parallel.ForEach(
    (inputs |> List.map (fun i -> taggedTexts |> List.map (fun t -> i, t)) |> List.concat),
    (fun (input : string, (tag, text)) ->
        let name = Path.GetFileNameWithoutExtension(input)
        let options =
            imageConfigs.TryFind(name)
            |> Option.defaultValue defaultConfig
        let format = format |> Option.defaultValue (Path.GetExtension(input))
        let output = sprintf "%s/%s-%s%s" output name (tag) format
        
        generateImage input text options output
    ))
|> ignore