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.

/

   81:- 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.

   96app_property(App, Property) :-
   97    bagof(App-Property, os:property_for_app(Property, App), Bag),
   98    member(App-Property, Bag).
   99
  100:- multifile os:property_for_app/2.  101
  102os:property_for_app(defined, App) :-
  103    os:property_for_app(path(_), App).
  104os:property_for_app(running, App) :-
  105    app_pid(App, _).
  106os:property_for_app(pid(PID), App) :-
  107    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.

  128app_start(App) :-
  129    app_property(App, defined),
  130    app_start_(App).
  131
  132app_start_(App) :-
  133    app_property(App, running),
  134    !.
  135app_start_(App) :-
  136    app_property(App, path(Path)),
  137    findall(Arg, app_property(App, argument(Arg)), Args),
  138    findall(Opt, app_property(App, option(Opt)),  Opts),
  139    include(current_predicate_option(process_create/3, 3), Opts, Opts_),
  140    process_create(Path, Args,
  141                   [   stdout(pipe(Out)),
  142                       stderr(pipe(Err)),
  143                       process(PID)|Opts_
  144                   ]),
  145    assertz(app_pid(App, PID)),
  146    option(alias(Alias), Opts, PID),
  147    (   option(encoding(Encoding), Opts)
  148    ->  set_stream(Out, encoding(Encoding)),
  149        set_stream(Err, encoding(Encoding))
  150    ;   true
  151    ),
  152    detach(wait_for_process(PID), [Alias, pid]),
  153    detach(read_lines_to_codes(App, stdout(Out)), [Alias, out]),
  154    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.
  162detach(Goal, Aliases) :-
  163    atomic_list_concat(Aliases, '_', Alias),
  164    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.
  173wait_for_process(PID) :-
  174    app_pid(App, PID),
  175    broadcast(os:app_started(App)),
  176    process_wait(PID, Status),
  177    retract(app_pid(App, PID)),
  178    broadcast(os:app_stopped(App, Status)).
  179
  180read_lines_to_codes(App, Term0) :-
  181    Term0 =.. [Name, Stream],
  182    repeat,
  183        read_line_to_codes(Stream, Codes),
  184        (   Codes == end_of_file
  185        ->  true
  186        ;   Term =.. [Name, Codes],
  187            catch(
  188                broadcast(os:app_decoded(App, Term)),
  189                Catcher,
  190                print_message(error, Catcher)),
  191            fail
  192        ),
  193        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.)

  204app_stop(App) :-
  205    app_property(App, pid(PID)),
  206    process_kill(PID).
  207
  208:- 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.

  223app_up(App) :-
  224    app_property(App, defined),
  225    app_up_(App).
  226
  227app_up_(App) :-
  228    app(App),
  229    !.
  230app_up_(App) :-
  231    app_start(App),
  232    assertz(app(App)).
  233
  234os:property_for_app(up, App) :-
  235    app(App).
  236os:property_for_app(down, App) :-
  237    \+ 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.
  244app_down(App) :-
  245    retract(app(App)),
  246    app_stop(App).
  247
  248listen :-
  249    unlisten,
  250    listen(os:app_stopped(App, _), app_stopped(App)).
  251
  252unlisten :-
  253    context_module(Module),
  254    unlisten(Module).
  255
  256:- 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.
  267app_stopped(App) :-
  268    app(App),
  269    thread_create(app_start(App), _, [detached(true)])