1:- module(os_apps,
    2          [   app_property/2,           % ?App:compound, ?Property
    3              app_start/1,              % ?App:compound
    4              app_stop/1,               % ?App:compound
    5              app_up/1,                 % ?App:compound
    6              app_down/1                % ?App:compound
    7          ]).    8
    9:- meta_predicate
   10    detach(0, +).

Operation system apps

What is an app? In this operating-system os_apps module context, simply something you can start and stop using a process. It has no standard input, and typically none or minimal standard output and error.

There is an important distinction between apps and processes. These predicates use processes to launch apps. An application typically has one process instance; else if not, has differing arguments to distinguish one running instance of the app from another. Hence for the same reason, the app model here ignores "standard input." Apps have no such input stream, conceptually speaking.

Is "app" the right word to describe such a thing? English limits the alternatives: process, no because that means something that loads an app; program, no because that generally refers the app's image including its resources.

## App configuration

Apps start by creating a process. Processes have four distinct specification parameter groups: a path specification, a list of arguments, possibly some execution options along with some optional encoding and other run-time related options. Call this the application's configuration.

The os_apps predicates rely on multi-file property_for_app/2 to configure the app launch path, arguments and options. The property-for-app predicate supplies an app's configuration non-deterministically using three sub-terms for the first Property argument, as follows.

Two things to note about these predicates; (1) App is a compound describing the app and its app-specific configuration information; (2) the first Property argument collates arguments and options non-deterministically. Predicate app_start/1 finds all the argument- and option-solutions in the order defined.

## Start up and shut down

By default, starting an app does not persist the app. It does not restart if the user or some other agent, including bugs, causes the app to exit. Consequently, this module offers a secondary app-servicing layer. You can start up or shut down any app. This amounts to starting and upping or stopping and downing, but substitutes shut for stop. Starting up issues a start but also watches for stopping.

## Broadcasts

Sends three broadcast messages for any given App, as follows:

Running apps send zero or more os:app_decoded(App, Term) messages, one for every line appearing in their standard output and standard error streams. Removes line terminators. App termination broadcasts an exit(Code) term for its final Status.

## Usage

You can start or stop an app.

app_start(App)
app_stop(App)

App is some compound that identifies which app to start and stop. You define an App using property_for_app/2 multi-file predicate. You must at least define an app's path using, as an example:

os:property_for_app(path(path(mspaint)), mspaint) :- !.

Note that the Path is a path Spec used by process_create/3, so can include a path-relative term as above. This is enough to launch the Microsoft Paint app on Windows. No need for arguments and options for this example. Starting a running app does not start a new instance. Rather, it succeeds for the existing instance. The green cut prevents unnecessary backtracking.

You can start and continuously restart apps using app_up/1, and subsequently shut them down with app_down/1.

### Apps testing

On a Windows system, try the following for example. It launches Microsoft Paint. Exit the Paint app after app_up/1 below and it will relaunch automatically.

?- [library(os/apps), library(os/apps_testing)].
true.

?- app_up(mspaint).
true.

?- app_down(mspaint).
true.

/

  119:- dynamic app_pid/2.
 app_property(?App:compound, ?Property) is nondet
Property of App.

Note that app_property(App, defined) should not throw an exception. Some apps have an indeterminate number of invocations where App is a compound with variables. Make sure that the necessary properties are ground, rather than unbound.

Collapses non-determinism to determinism by collecting App and Property pairs before expanding the bag to members non-deterministically.

  134app_property(App, Property) :-
  135    bagof(App-Property, os:property_for_app(Property, App), Bag),
  136    member(App-Property, Bag).
  137
  138:- multifile os:property_for_app/2.  139
  140os:property_for_app(defined, App) :-
  141    os:property_for_app(path(_), App).
  142os:property_for_app(running, App) :-
  143    app_pid(App, _).
  144os:property_for_app(pid(PID), App) :-
  145    app_pid(App, PID).
 app_start(?App:compound) is nondet
Starts an App if not already running. Starts more than one apps non-deterministically if App binds with more than one specifier. Does not restart the app if launching fails. See app_up/1 for automatic restarts. An app's argument and option properties execute non-deterministically.

Options can include the following:

encoding(Encoding)
an encoding option for the output and error streams.
alias(Alias)
an alias prefix for the detached watcher thread.

Checks for not-running after unifying with the App path. Succeeds if already running.

  166app_start(App) :-
  167    app_property(App, defined),
  168    app_start_(App).
  169
  170app_start_(App) :-
  171    app_property(App, running),
  172    !.
  173app_start_(App) :-
  174    app_property(App, path(Path)),
  175    findall(Arg, app_property(App, argument(Arg)), Args),
  176    findall(Opt, app_property(App, option(Opt)),  Opts),
  177    include(current_predicate_option(process_create/3, 3), Opts, Opts_),
  178    process_create(Path, Args,
  179                   [   stdout(pipe(Out)),
  180                       stderr(pipe(Err)),
  181                       process(PID)|Opts_
  182                   ]),
  183    assertz(app_pid(App, PID)),
  184    option(alias(Alias), Opts, PID),
  185    (   option(encoding(Encoding), Opts)
  186    ->  set_stream(Out, encoding(Encoding)),
  187        set_stream(Err, encoding(Encoding))
  188    ;   true
  189    ),
  190    detach(wait_for_process(PID), [Alias, pid]),
  191    detach(read_lines_to_codes(App, stdout(Out)), [Alias, out]),
  192    detach(read_lines_to_codes(App, stderr(Err)), [Alias, err]).
 detach(:Goal, +Aliases:list(atom)) is det
Important to assert the app_pid(App, PID) before detaching the threads. They will unify with the App in order to access the process identifier, PID. Note assertz/1 usage above.
  200detach(Goal, Aliases) :-
  201    atomic_list_concat(Aliases, '_', Alias),
  202    thread_create(Goal, _, [detached(true), alias(Alias)]).
 wait_for_process(+App) is semidet
Waits for App to exit in its own detached thread. Retracts the App-PID pair immediately after process exit. Broadcasts an App stopped message with the process exit status. This is the sole purpose of the wait.
  211wait_for_process(PID) :-
  212    app_pid(App, PID),
  213    broadcast(os:app_started(App)),
  214    process_wait(PID, Status),
  215    retract(app_pid(App, PID)),
  216    broadcast(os:app_stopped(App, Status)).
  217
  218read_lines_to_codes(App, Term0) :-
  219    Term0 =.. [Name, Stream],
  220    repeat,
  221        read_line_to_codes(Stream, Codes),
  222        (   Codes == end_of_file
  223        ->  true
  224        ;   Term =.. [Name, Codes],
  225            catch(
  226                broadcast(os:app_decoded(App, Term)),
  227                Catcher,
  228                print_message(error, Catcher)),
  229            fail
  230        ),
  231        close(Stream).
 app_stop(?App:compound) is nondet
Kills the App process. Stopping the app does not prevent subsequent automatic restart.

Killing does not retract the app_pid/2 by design. Doing so would trigger a failure warning. (The waiting PID-monitor thread would die on failure because its retract attempt fails.)

  242app_stop(App) :-
  243    app_property(App, pid(PID)),
  244    process_kill(PID).
  245
  246:- dynamic app/1.
 app_up(?App:compound) is nondet
Starts up an App.

Semantics of this predicate rely on app_start/1 succeeding even if already started. That way, you can start an app then subsequently up it, meaning stay up. Hence, you can app_stop(App) to force a restart if already app_up(App). Stopping an app does not down it!

Note that app_start/1 will fail for one of two reasons: (1) because the App has not been defined yet; (2) because starting it fails for some reason.

  261app_up(App) :-
  262    app_property(App, defined),
  263    app_up_(App).
  264
  265app_up_(App) :-
  266    app(App),
  267    !.
  268app_up_(App) :-
  269    app_start(App),
  270    assertz(app(App)).
  271
  272os:property_for_app(up, App) :-
  273    app(App).
  274os:property_for_app(down, App) :-
  275    \+ app(App).
 app_down(?App:compound) is nondet
Shuts down an App. Shuts down multiple apps non-deterministically if the App compound matches more than one app definition.
  282app_down(App) :-
  283    retract(app(App)),
  284    app_stop(App).
  285
  286listen :-
  287    unlisten,
  288    listen(os:app_stopped(App, _), app_stopped(App)).
  289
  290unlisten :-
  291    context_module(Module),
  292    unlisten(Module).
  293
  294:- initialization listen.
 app_stopped(+App) is semidet
The broadcast triggers in the PID-monitoring thread. Do not try to restart the app in the same thread. Starting tries to create a new PID-monitoring thread with the same alias, if an alias for the app has been given. This will fail since the current thread carries the same alias from the previous start operation. Avoid this race condition by restarting the app after the broadcast thread exits.
  305app_stopped(App) :-
  306    app(App),
  307    thread_create(app_start(App), _, [detached(true)])