///- --package .

offscreen (test)

///- --test static --symbol

:< testing

:< sm'_operators

:== launch = { exe : string; directory : string; arguments : string; desktop : string; timeout_seconds : i32 }

:| parsed =
    | Ready : launch
    | MissingExe
    | MissingValue : string
    | BadTimeout : string
    | UnknownFlag : string

:| outcome =
    | Exited : u32 * u32
    | TimedOut : u32 * u32
    | NoDesktop : u32
    | NotStarted : u32

:= defaults () : launch = { exe = ""; directory = ""; arguments = ""; desktop = "tibia-probe"; timeout_seconds = 120 }

:= timeout_set (l : launch) (value : string) : parsed =
    ?= convert::try_convert value ?|
    | Some seconds => Ready { l ?| timeout_seconds = seconds }
    | None => BadTimeout value

:| text_flag =
    | Exe
    | Directory
    | Arguments
    | Desktop

:| number_flag =
    | TimeoutSeconds

:| flag =
    | Text : text_flag
    | Number : number_flag

:= flag_named (name : string) : option flag =
    ?= case_labels::case_of_label "" "-" name ?|
    | Some t => Some (Text t)
    | None => ?= case_labels::case_of_label "" "-" name ?| Some n => Some (Number n) | None => None

:= flag_of (text : string) : option flag =
    ? sm'::starts_with "--" text ?> flag_named (case_labels::unprefixed "--" text) |: None

:= text_set (l : launch) (f : text_flag) (v : string) : launch =
    ?= f ?|
    | Exe => { l ?| exe = v }
    | Directory => { l ?| directory = v }
    | Arguments => { l ?| arguments = v }
    | Desktop => { l ?| desktop = v }

:= number_set (l : launch) (f : number_flag) (v : string) : parsed =
    ?= f ?|
    | TimeoutSeconds => timeout_set l v

:= flag_set (l : launch) (f : flag) (v : string) : parsed =
    ?= f ?|
    | Text t => Ready (text_set l t v)
    | Number n => number_set l n v

:= flag_step (l : launch) (text : string) (value : string) : parsed =
    ?= flag_of text ?|
    | Some f => flag_set l f value
    | None => UnknownFlag text

:= finished_parse (l : launch) : parsed = ? l::exe = "" ?> MissingExe |: Ready l

:~ ^ parse_from (args : list string) (l : launch) : parsed =
    ?= args ?|
    | [] => finished_parse l
    | flag :: [] => MissingValue flag
    | flag :: value :: rest => ?= flag_step l flag value ?| Ready next => parse_from rest next | failed => failed

:= parse (args : list string) : parsed = parse_from args (defaults ())

:= command_line (l : launch) : string =
    := quoted = "\"" ++# l::exe ++# "\""
    ? l::arguments = "" ?> quoted |: quoted ++# " " ++# l::arguments

:= station_desktop (l : launch) : string = "WinSta0\\" ++# l::desktop

:= exit_line (l : launch) (pid : u32) (code : u32) : string =
    "offscreen: pid " ++#? pid ++# " exit " ++#? code ++# " on desktop " ++# l::desktop

:= killed_line (l : launch) : string = "offscreen: killed after " ++#? l::timeout_seconds ++# " s"

:= failure_report (o : outcome) : list string =
    ?= o ?|
    | NoDesktop error => [ "CreateDesktop failed: " ++#? error ]
    | NotStarted error => [ "CreateProcess failed: " ++#? error ]
    | _ => []

:= report (l : launch) (o : outcome) : list string =
    ?= o ?|
    | Exited (pid, code) => [ exit_line l pid code ]
    | TimedOut (pid, code) => [ killed_line l; exit_line l pid code ]
    | _ => failure_report o

:= exit_code_of (o : outcome) : i32 =
    ?= o ?|
    | Exited _ => 0
    | TimedOut _ => 0
    | NoDesktop _ => 1
    | NotStarted _ => 1

:= killed_exit_code () : u32 = 124

:= win32_pointer_types () =
    global "type Wide = *const u16;"
    global "type Line = *mut u16;"
    global "type Bytes = *const u8;"
    global "type Startup = *const StartupInfo;"
    global "type Information = *mut ProcessInformation;"

:= win32_null_pointers () =
    global "const NONE: Bytes = std::ptr::null();"
    global "const NO_WIDE: Wide = std::ptr::null();"

:= win32_create_desktop () =
    global (
        "unsafe extern \"system\" { safe fn CreateDesktopW(_: Wide, _: Wide, _: Bytes, _: u32, _: u32, _: Bytes) "
        ^^ "-> i64; }"
    )

:= win32_close_desktop () =
    global (
        "#[cfg_attr(windows, link(name = \"user32\"))] unsafe extern \"system\" { safe fn CloseDesktop(_: i64) -> "
        ^^ "i32; }"
    )

:= win32_process_queries () =
    global "unsafe extern \"system\" { safe fn GetLastError() -> u32; }"
    global "unsafe extern \"system\" { safe fn GetProcessId(process: i64) -> u32; }"

:= win32_process_control () =
    global "unsafe extern \"system\" { safe fn WaitForSingleObject(handle: i64, milliseconds: u32) -> u32; }"
    global "unsafe extern \"system\" { safe fn TerminateProcess(process: i64, code: u32) -> i32; }"

:= win32_handle_declarations () =
    global "unsafe extern \"system\" { safe fn GetExitCodeProcess(process: i64, code: *mut u32) -> i32; }"
    global "unsafe extern \"system\" { safe fn CloseHandle(handle: i64) -> i32; }"

:= win32_create_process () =
    global (
        "unsafe extern \"system\" { safe fn CreateProcessW(_: Wide, _: Line, _: Bytes, _: Bytes, _: i32, _: u32, "
        ^^ "_: Bytes, _: Wide, _: Startup, _: Information) -> i32; }"
    )

:= win32_startup_declaration () =
    global (
        "#[repr(C)] #[derive(Default)] struct StartupInfo { cb: u32, pointers: [usize; 3], geometry: [u32; 8], "
        ^^ "show: [u16; 2], reserved2: usize, handles: [i64; 3] }"
    )

:= win32_information_declaration () =
    global (
        "#[repr(C)] #[derive(Default, Clone, Copy)] struct ProcessInformation { process: i64, thread: i64, "
        ^^ "process_id: u32, thread_id: u32 }"
    )

:= win32_types () =
    win32_pointer_types ()
    win32_null_pointers ()
    win32_startup_declaration ()
    win32_information_declaration ()

:= win32_externs () =
    win32_create_desktop ()
    win32_close_desktop ()
    win32_process_queries ()
    win32_process_control ()
    win32_handle_declarations ()
    win32_create_process ()

:= win32_declarations () =
    win32_types ()
    win32_externs ()

:! wide = $'Vec<u16>'
:! wide_pointer = $'*const u16'
:! wide_mutable_pointer = $'*mut u16'

:! address = $'usize'
:! startup_info = $'StartupInfo'
:! process_information = $'std::cell::Cell<ProcessInformation>'

:! information_pointer = $'*mut ProcessInformation'
:! exit_code_cell = $'std::cell::Cell<u32>'
:! byte_pointer = $'*const u8'

:= wide_of (text : string) : wide =
    win32_declarations ()
    $'(&*!text).encode_utf16().chain(std::iter::once(0)).collect::<Vec<u16>>()' : wide

:= wide_start (text : wide) : wide_pointer = $'!text.as_ptr()' : wide_pointer

:= wide_mutable_start (text : wide) : wide_mutable_pointer = $'!text.as_ptr().cast_mut()' : wide_mutable_pointer

:= wide_address (text : wide) : address = $'!text.as_ptr().addr()' : address

:= create_desktop_at (name : wide_pointer) : i64 = $'CreateDesktopW(!name, NO_WIDE, NONE, 0, 0x01FF, NONE)' : i64

:= close_desktop (desktop : i64) : () =
    win32_declarations ()
    ignore ($'CloseDesktop(!desktop)' : i32)

:= last_error () : u32 =
    win32_declarations ()
    $'GetLastError()' : u32

:= startup_size () : u32 = $'u32::try_from(std::mem::size_of::<StartupInfo>()).unwrap()' : u32

:= startup_on (size : u32) (desktop : address) : startup_info =
    $'StartupInfo { cb: !size, pointers: [0, !desktop, 0], ..Default::default() }' : startup_info

:= information_empty () : process_information =
    $'std::cell::Cell::new(ProcessInformation::default())' : process_information

:= information_start (information : process_information) : information_pointer =
    $'!information.as_ptr()' : information_pointer

:= create_process_at
    (app : wide_pointer) (line : wide_mutable_pointer) (folder : wide_pointer) (startup : startup_info)
    (info : information_pointer)
    : i32
    =
    $'CreateProcessW(!app, !line, NONE, NONE, 0, 0, NONE, !folder, &!startup, !info)' : i32

:= information_process (information : process_information) : i64 = $'!information.get().process' : i64

:= information_thread (information : process_information) : i64 = $'!information.get().thread' : i64

:= close_handle (handle : i64) : () = ignore ($'CloseHandle(!handle)' : i32)

:= exit_code_empty () : exit_code_cell = $'std::cell::Cell::new(0u32)' : exit_code_cell

:= exit_code_read (process : i64) (cell : exit_code_cell) : () =
    ignore ($'GetExitCodeProcess(!process, !cell.as_ptr())' : i32)

:= exit_code_value (cell : exit_code_cell) : u32 = $'!cell.get()' : u32

:= create_desktop (name : string) : i64 =
    := wide_name = wide_of name
    create_desktop_at (wide_start wide_name)

:= working_folder (exe : string) (directory : string) : string =
    ? directory <> "" ?> directory
    |:
        ?= file_system::directory_get_parent exe |> optionm'::unbox ?|
        | Some parent => parent
        | None => ""

:== process_wides = { application : wide; command : wide; folder : wide; desktop : wide }

:= wides_of (station : string) (exe : string) (line : string) (directory : string) : process_wides =
    {
        application = wide_of exe
        command = wide_of line
        folder = wide_of (working_folder exe directory)
        desktop = wide_of station
    }

:= startup_for (w : process_wides) : startup_info = startup_on (startup_size ()) (wide_address w::desktop)

:= created_with (w : process_wides) (information : process_information) : i32 =
    := app, line, folder = wide_start w::application, wide_mutable_start w::command, wide_start w::folder
    create_process_at app line folder (startup_for w) (information_start information)

:= started_process (information : process_information) (created : i32) : i64 =
    ? created = 0 ?> 0
    |:
        close_handle (information_thread information)
        information_process information

:= start_on (station : string) (exe : string) (line : string) (directory : string) : i64 =
    := w = wides_of station exe line directory
    := information = information_empty ()
    started_process information (created_with w information)

:= process_id (process : i64) : u32 =
    win32_declarations ()
    $'GetProcessId(!process)' : u32

:= wait_for (process : i64) (milliseconds : u32) : u32 =
    win32_declarations ()
    $'WaitForSingleObject(!process, !milliseconds)' : u32

:= terminate (process : i64) (code : u32) : () =
    win32_declarations ()
    ignore ($'TerminateProcess(!process, !code)' : i32)

:= exit_status (process : i64) : u32 =
    win32_declarations ()
    := cell = exit_code_empty ()
    exit_code_read process cell
    exit_code_value cell

:= close_process (process : i64) : () =
    win32_declarations ()
    close_handle process

:= finished_outcome (process : i64) (pid : u32) (timed_out : bool) : outcome =
    := code = exit_status process
    close_process process
    ? timed_out ?> TimedOut (pid, code) |: Exited (pid, code)

:= waited_out (l : launch) (process : i64) : outcome =
    := pid = process_id process
    := timed_out = wait_for process (conv l::timeout_seconds * 1000u32) <> 0
    ? timed_out ?> terminate process (killed_exit_code ())
    finished_outcome process pid timed_out

:= run_started (l : launch) : outcome =
    := process = start_on (station_desktop l) l::exe (command_line l) l::directory
    ? process = 0 ?> NotStarted (last_error ()) |: waited_out l process

:= run_on_desktop (l : launch) : outcome =
    := desktop = create_desktop l::desktop
    ? desktop = 0 ?> NoDesktop (last_error ())
    |:
        := o = run_started l
        close_desktop desktop
        o

:= ready_launch (p : parsed) : launch =
    ?= p ?|
    | Ready l => l
    | _ => { (defaults ()) ?| desktop = "not ready" }

:= missing_exe (p : parsed) : bool =
    ?= p ?|
    | MissingExe => !+
    | _ => !-

:= bad_timeout (p : parsed) : string =
    ?= p ?|
    | BadTimeout value => value
    | _ => ""

:= missing_value (p : parsed) : string =
    ?= p ?|
    | MissingValue flag => flag
    | _ => ""

:= probe_launch () : launch = ready_launch (parse [ "--exe"; "C:\\otc\\otclient.exe"; "--arguments"; "--mode probe" ])

flags_fill_the_launch_and_keep_the_script_defaults (test)

///- --test --symbol
///> lua
///> rust

:= l = probe_launch ()
(l::desktop, l::timeout_seconds) |> _assert_eq ("tibia-probe", 120i32)

__assert_eq { expected = (tibia-probe, 120) }
lua: unavailable on this machine (`spiral lua --lua-path /tmp/spiral_cells/1793692448464-324/main.lua` was not found)

0

flags_build_the_quoted_command_line_on_the_probe_station (test)

///- --test --symbol
///> lua
///> rust

:= l = probe_launch ()
(command_line l, station_desktop l) |> _assert_eq ("\"C:\\otc\\otclient.exe\" --mode probe", "WinSta0\\tibia-probe")

__assert_eq { expected = ("C:\otc\otclient.exe" --mode probe, WinSta0\tibia-probe) }
lua: unavailable on this machine (`spiral lua --lua-path /tmp/spiral_cells/1793692448465-356/main.lua` was not found)

0

bad_input_names_its_cause (test)

///- --test --symbol
///> lua
///> rust

missing_exe (parse [ "--desktop"; "x" ]) |> _assert_eq !+
missing_value (parse [ "--exe" ]) |> _assert_eq "--exe"

__assert_eq { expected = true }
__assert_eq { expected = --exe }
lua: unavailable on this machine (`spiral lua --lua-path /tmp/spiral_cells/1793692448503-3/main.lua` was not found)

0

a_bad_timeout_names_its_value (test)

///- --test --symbol
///> lua
///> rust

bad_timeout (parse [ "--exe"; "a.exe"; "--timeout-seconds"; "soon" ]) |> _assert_eq "soon"

__assert_eq { expected = soon }
lua: unavailable on this machine (`spiral lua --lua-path /tmp/spiral_cells/1793692448529-35/main.lua` was not found)

0

a_flag_is_its_case_after_two_dashes (test)

///- --test --symbol
///> lua
///> rust

(flag_of "--timeout-seconds", flag_of "--directory", flag_of "timeout-seconds", flag_of "--speed")
|> _assert_eq (Some (Number TimeoutSeconds), Some (Text Directory), None, None)

__assert_eq { expected = (Some(Number(TimeoutSeconds)), Some(Text(Directory)), None, None) }
lua: unavailable on this machine (`spiral lua --lua-path /tmp/spiral_cells/1793692459172-5346/main.lua` was not found)

0

every_flag_reaches_its_field (test)

///- --test --symbol
///> lua
///> rust

:= l = ready_launch (parse [ "--exe"; "a.exe"; "--directory"; "C:\\otc"; "--timeout-seconds"; "9" ])
(l::directory, l::timeout_seconds) |> _assert_eq ("C:\\otc", 9i32)

__assert_eq { expected = (C:\otc, 9) }
lua: unavailable on this machine (`spiral lua --lua-path /tmp/spiral_cells/1793692459291-5410/main.lua` was not found)

0

:= thirty_second_launch () : launch =
    := base = defaults ()
    { base ?| exe = "a.exe"; timeout_seconds = 30 }

reports_match_run_offscreen_ps1 (test)

///- --test --symbol
///> lua
///> rust

report (thirty_second_launch ()) (Exited (77u32, 0u32))
|> _assert_eq [ "offscreen: pid 77 exit 0 on desktop tibia-probe" ]

__assert_eq { expected = Cons(offscreen: pid 77 exit 0 on desktop tibia-probe, Nil) }
lua: unavailable on this machine (`spiral lua --lua-path /tmp/spiral_cells/1793692460656-259/main.lua` was not found)

0

a_timeout_report_matches_run_offscreen_ps1 (test)

///- --test --symbol
///> lua
///> rust

report (thirty_second_launch ()) (TimedOut (77u32, 124u32))
|> _assert_eq [ "offscreen: killed after 30 s"; "offscreen: pid 77 exit 124 on desktop tibia-probe" ]

__assert_eq { expected = Cons(offscreen: killed after 30 s, Cons(offscreen: pid 77 exit 124 on desktop tibia-probe, Nil)) }
lua: unavailable on this machine (`spiral lua --lua-path /tmp/spiral_cells/1793692460699-291/main.lua` was not found)

0

:= hidden_exit (windows : bool) : i64 * i64 =
    := desktop = ? windows ?> create_desktop "spiral-offscreen-test" |: 1
    := cmd = "C:\\Windows\\System32\\cmd.exe"
    desktop, ? windows ?> start_on "WinSta0\\spiral-offscreen-test" cmd "cmd.exe /c exit 3" "" |: 1

:= hidden_cleanup (windows : bool) (desktop : i64) (process : i64) : () =
    ? windows ?>
        close_process process
        close_desktop desktop

:= hidden_result (windows : bool) (desktop : i64) (process : i64) : u32 * u32 =
    := waited = ? windows ?> wait_for process 10000u32 |: 0u32
    := code = ? windows ?> exit_status process |: 3u32
    hidden_cleanup windows desktop process
    waited, code

a_hidden_desktop_runs_a_program_and_reports_its_exit_code (test)

///- --test --symbol
///> rust

:= windows = platform::is_windows ()
:= desktop, process = hidden_exit windows
(desktop <> 0, process <> 0, hidden_result windows desktop process) |> _assert_eq (!+, !+, (0u32, 3u32))

__assert_eq { expected = (true, true, 0, 3) }

0

:= input_refusal (p : parsed) : string =
    ?= p ?|
    | BadTimeout value => "offscreen: --timeout-seconds is not a number: " ++# value
    | UnknownFlag flag => "offscreen: unknown flag " ++# flag
    | _ => ""

:= refusal_text (p : parsed) : string =
    ?= p ?|
    | MissingExe => "offscreen: --exe is required"
    | MissingValue flag => "offscreen: " ++# flag ++# " needs a value"
    | _ => input_refusal p

:= refusal_code (p : parsed) : i32 =
    console::write_line (refusal_text p)
    2

:= launched_code (l : launch) : i32 =
    := o = run_on_desktop l
    listm::iter console::write_line (report l o)
    exit_code_of o

///> _
:= main () =
    := p = parse (env::command_line_arguments ())
    := code = ?= p ?| Ready l => launched_code l | _ => refusal_code p
    $'std::process::exit(!code)' : ()