Supervise restartable task generations.

--  This name survives restarts; task objects do not.
type Service is (Metrics);

--  The application still owns the task's shape, entries, and execution model.
--  Control is borrowed from the supervisor for this generation only.
task type Metrics_Task
  (Context : not null access Metrics_Context;
   Control : not null access Generation_Control)
with CPU => 2 is
   --  The service runs as a lightweight task in execution group 2.
   pragma Task_Info (Flyology.Lightweight_Task);
   entry Start;
end Metrics_Task;

task body Metrics_Task is
begin
   --  Reacquire generation-owned resources instead of inheriting them from
   --  the task object that failed.
   declare
      Resources : Metrics_Resources := Acquire (Context);
   begin
      --  Initialize calls this entry after Ada activation succeeds.
      accept Start;

      --  Dependents cannot see this generation until acquisition succeeded.
      Mark_Ready (Control.all);
      loop
         --  Stop is cooperative. Task-aware I/O may use the same token.
         if Stopping (Control.all).Requested then
            raise Flyology.Cancellation.Operation_Cancelled;
         end if;

         Sample (Resources);
         delay 1.0;
      end loop;
   end;  --  Resources finalize while an exception unwinds or before return.
         --  GNARL then publishes the bounded task result automatically.
end Metrics_Task;

procedure Initialize
  (Subject : in out Metrics_Task;
   Control : aliased in out Generation_Control)
is
   pragma Unreferenced (Control);
begin
   --  This rendezvous is application-specific startup, outside supervisor
   --  locks. It must return so the readiness deadline remains observable.
   Subject.Start;
end Initialize;

function Task_Identity
  (Subject : in out Metrics_Task)
   return Ada.Task_Identification.Task_Id is
  (Subject'Identity);

procedure Abort_Task (Subject : in out Metrics_Task) is
begin
   abort Subject;
end Abort_Task;

function Create
  (Context : not null access Metrics_Context;
   Control : not null access Generation_Control) return Metrics_Task
is
begin
   --  Limited build-in-place return constructs the exact task object under
   --  Task_Generations.Run's local Ada master.
   return Subject : Metrics_Task (Context, Control);
end Create;

--  This generic owns construction, observation, optional abort, and join for
--  one Metrics_Task generation. It does not replace the task's public API.
package Metrics_Generation is new Flyology.Supervision.Task_Generations
  (Application_Context => Metrics_Context,
   Generation_Task     => Metrics_Task,
   --  Create, Task_Identity, and Abort_Task are inferred by name.
   Initialize          => Initialize);

procedure Run_Generation
  (Context : aliased in out Metrics_Context;
   Child   : Service;
   Control : aliased in out Generation_Control;
   Result  : out Generation_Result)
is
   pragma Unreferenced (Child);
begin
   --  Each call constructs and joins one fresh Metrics_Task. Static.Run calls
   --  this again only when policy admits a replacement generation.
   Metrics_Generation.Run (Context, Control, Result);
end Run_Generation;

--  Recovery is finite in rate, attempt count, delay, and elapsed time.
Limits : constant Recovery_Limits :=
  (--  Admit at most 3 attempts in any 5-second monotonic window.
   Burst_Attempts    => 3,
   Window            => Ada.Real_Time.Seconds (5),

   --  Admit at most 10 attempts before this recovery incident is exhausted.
   Total_Attempts    => 10,

   --  Wait 10 ms before attempt 1, double after consecutive attempts, and
   --  never delay longer than 1 second.
   Initial_Backoff   => Ada.Real_Time.Milliseconds (10),
   Maximum_Backoff   => Ada.Real_Time.Seconds (1),

   --  Staying ready for 30 seconds closes the incident and resets accounting.
   Stability_Reset   => Ada.Real_Time.Seconds (30),

   --  Reject any attempt or backoff that cannot fit inside this absolute
   --  60-second recovery interval.
   Recovery_Deadline => Ada.Real_Time.Seconds (60));

--  The logical id stays 1 while Ada task identity changes on every restart.
function Logical_Id (Child : Service) return Child_Id is
  (case Child is when Metrics => 1);

function Policy (Child : Service) return Child_Specification is
  (case Child is
      when Metrics =>
        (--  Replace Metrics after a failure, but not after ordinary return or
         --  supervisor shutdown.
         Restart           => On_Failure,

         --  No sibling needs coordinated recovery in this one-child tree.
         Impact            => Isolate_Child,

         --  Apply Limits to restart admission for this logical child.
         Recovery          => Limits,

         --  Allow 5 seconds for cooperative cleanup, request no Ada abort by
         --  default, and preserve a still-live task as stuck.
         Stopping          => Default_Stop_Policy,

         --  The new generation must call Mark_Ready within 2 seconds.
         Readiness_Timeout => Ada.Real_Time.Seconds (2),

         --  The application promises a new generation can safely reacquire
         --  resources after the previous generation has finalized.
         Restart_Safe      => True,

         --  Repeat the exact model selected by Metrics_Task's Task_Info. This
         --  policy value does not itself make the task lightweight.
         Task_Model        => Flyology.Lightweight_Task,

         --  Has_Group makes Group meaningful; 2 matches the task's CPU aspect.
         Has_Group         => True,
         Group             => 2));

--  A one-child topology has neither dependencies nor named cohorts.
function No_Relationship (Left, Right : Service) return Boolean is
  (False);

--  The static generic validates the typed topology before starting children.
package Metrics_Supervision is new Flyology.Supervision.Static
  (--  Service is the closed set of logical children. Larger instances may
   --  map each enumeration value to a different application task type.
   Child_Kind          => Service,

   --  One typed context is borrowed until the synchronous Run call joins the
   --  complete tree.
   Application_Context => Metrics_Context,

   --  Give every logical child a stable identity across task generations.
   Logical_Id          => Logical_Id,

   --  Return the child-level restart, stop, readiness, safety, and placement
   --  policy declared above.
   Specification       => Policy,

   --  False for every pair: Metrics has neither readiness prerequisites nor
   --  dependents.
   Depends_On          => No_Relationship,

   --  False for every pair: no named cohort is configured.
   Cohort_Member       => No_Relationship,

   --  Construct, observe, and join one fresh Metrics_Task generation.
   Run_One_Generation  => Run_Generation,

   --  Bound aggregate restart activity across the whole node. A one-child
   --  node deliberately reuses the same numeric limits as its child.
   Subtree_Recovery    => Limits);

declare
   Node    : aliased Metrics_Supervision.Supervisor;
   Context : aliased Metrics_Context;
   Result  : Supervisor_Result;
begin
   --  Run synchronously owns the whole tree. It returns only after every
   --  generation and supervisor manager that can terminate has joined.
   Metrics_Supervision.Run (Node, Context, Result);
end;

declare
   Watch : Flyology.Task_Results.Monitor;
begin
   --  Attach while Worker and its Task_Id are still valid.
   Flyology.Task_Results.Attach (Watch, Worker'Identity);

   --  Watch retains only the fixed result sidecar and completion gate. The
   --  Ada task still joins through its ordinary master, and its object may be
   --  reclaimed before a later Observe or Wait on Watch.
   declare
      Outcome : constant Flyology.Task_Results.Task_Observation :=
        Flyology.Task_Results.Wait (Watch, Timeout => 2.0);
   begin
      if Outcome.Status = Flyology.Task_Results.Terminal then
         Render (Outcome.Result);
      end if;
   end;

   --  Detach is idempotent. Finalization also detaches it automatically.
   Flyology.Task_Results.Detach (Watch);
end;

declare
   --  Latest returns Metrics' current logical id plus its exact generation.
   Generation : constant Child_Handle :=
     Metrics_Supervision.Latest (Supervisor, Metrics);

   --  Registration and the current-generation check happen atomically inside
   --  the controller. This wait never changes its target to a replacement.
   Outcome : constant Generation_Observation :=
     Metrics_Supervision.Wait_Termination
       (Supervisor, Metrics, Generation, Timeout => 2.0);
begin
   case Outcome.Status is
      when Generation_Terminated =>
         Render_Termination (Outcome.Snapshot);
      when Generation_Replaced =>
         Render_Replacement (Outcome.Snapshot);
      when Observation_Timed_Out =>
         null; --  The exact generation was still live at the timeout.
   end case;
end;

type Public_Service is (Metrics_API);

--  Each service key maps to the static child's stable logical id.
function Logical_Id (Service : Public_Service) return Child_Id is
  (case Service is when Metrics_API => 1_001);

--  The directory has one fixed slot per enumeration value. It stores no
--  endpoint pointer, task access value, callback, or application payload.
package Published is new Flyology.Supervision.Service_Slots
  (Service_Kind => Public_Service,
   Logical_Id   => Logical_Id);

Directory : aliased Published.Directory;

task body Metrics_Task is
   --  Finalization withdraws only this exact publication token. It cannot
   --  remove a later generation that reused Metrics_API.
   --  The access discriminant makes Ada reject a Publication whose directory
   --  could finalize first.
   Availability : Published.Publication (Directory'Access);
begin
   declare
      Resources : Metrics_Resources := Acquire_Fresh_Resources;
   begin
      Initialize_Endpoint (Context.Endpoint, Resources);

      --  Publish_Ready first reserves the typed slot, then reports readiness,
      --  and only afterward makes the lease acquirable. Duplicate and wrong-
      --  child errors are rejected before readiness changes.
      Published.Publish_Ready
        (Availability, Metrics_API, Control.all);

      Serve (Context.Endpoint, Resources, Stopping (Control.all));
   end;
end Metrics_Task;

--  A client copies the current lease. Unavailable is an ordinary handoff
--  state while no ready generation is published.
Observation := Published.Acquire (Directory, Metrics_API);
if Observation.Status = Published.Available then
   --  Validate Observation.Lease inside the same protected endpoint operation
   --  that performs the request. A separate Current check would race.
   Context.Endpoint.Submit (Observation.Lease, Request);
end if;

Generation := Services.Latest (Supervisor, API);

if Operator_Requested_Restart then
   --  Requires Restart_Safe, a local impact, and a restart kind other than
   --  Never. This still consumes the child and subtree incident attempt.
   Services.Restart (Supervisor, API, Generation);
elsif not Probe (Context.API, Generation) then
   --  The diagnostic is copied into bounded storage before the controller
   --  requests cooperative stop.
   Services.Report_Unhealthy
     (Supervisor, API, Generation, "readiness probe failed");
end if;

--  A task may also reject itself after an internal invariant or liveness
--  check fails. The call records Unhealthy and requests its own stop token.
Report_Unhealthy (Control.all, "upstream session cannot be reconciled");

--  An enumeration makes the heterogeneous topology closed and exhaustive.
type Service is (Metrics);

--  This identity is stable across every Metrics_Task generation.
function Logical_Id (Child : Service) return Child_Id is
  (case Child is when Metrics => 4_294_967_297);

--  The configured task model and group describe what observers should expect.
--  Metrics_Task declaration remains authoritative for its actual aspects.
function Specification (Child : Service)
  return Child_Specification is
  (--  Replace Metrics after an exception, abort, timeout, or startup failure,
   --  but not after an ordinary return or supervisor shutdown.
   Restart           => On_Failure,

   --  A Metrics failure does not stop unrelated logical children.
   Impact            => Isolate_Child,

   --  Use the finite attempt, rate, backoff, and deadline limits above.
   Recovery          => Limits,

   --  Request cooperative stop and allow 5 seconds for cleanup. This default
   --  does not request Ada abort; a still-live task is observed as stuck.
   Stopping          => Default_Stop_Policy,

   --  Fail startup unless this generation calls Mark_Ready within 2 seconds.
   Readiness_Timeout => Ada.Real_Time.Seconds (2),

   --  The application promises that a fresh task may safely reacquire all
   --  generation-owned resources after the old generation has finalized.
   Restart_Safe      => True,

   --  Repeat the expected task model for snapshots and policy validation.
   --  Metrics_Task's aspect remains authoritative for actual execution.
   Task_Model        => Flyology.Lightweight_Task,

   --  Has_Group makes Group meaningful for a lightweight task; group 2 must
   --  agree with Metrics_Task's CPU aspect above.
   Has_Group         => True,
   Group             => 2);

--  No prerequisite must be ready before this independent service starts.
function Depends_On (Child, Prerequisite : Service)
  return Boolean is (False);

--  This independent service belongs to no named recovery cohort.
function Cohort_Member (Trigger, Member : Service)
  return Boolean is (False);

--  A larger enumeration uses the same generic and dispatches each member to
--  its own Task_Generations instance inside Run_Generation.
package Metrics_Supervision is new Flyology.Supervision.Static
  (--  The enumeration defines the closed, heterogeneous topology and indexes
   --  the instance's bounded child state.
   Child_Kind          => Service,

   --  One typed application value is borrowed by every generation runner and
   --  must outlive the synchronous Metrics_Supervision.Run call.
   Application_Context => Metrics_Context,

   --  Map each enumeration value to its stable, externally observable id.
   Logical_Id          => Logical_Id,

   --  Supply restart, stopping, readiness, safety, and placement policy.
   Specification       => Specification,

   --  Declare readiness prerequisites; Static validates the graph and derives
   --  deterministic start, reverse-stop, and dependent-restart order.
   Depends_On          => Depends_On,

   --  Name the members restarted together when a child's impact selects its
   --  cohort. This function is ignored by other impact choices.
   Cohort_Member       => Cohort_Member,

   --  Construct, observe, and join one fresh task generation for the selected
   --  service. An exhaustive dispatcher can choose a different task type for
   --  every Child_Kind value.
   Run_One_Generation  => Run_Generation);

--  This excerpt focuses on topology. Shared_Recovery is a finite
--  Recovery_Limits value; Service_Policy returns a complete policy for each
--  remaining service.
type Service is (Database, Cache, API, Telemetry);

--  Arguments read as "Child requires Prerequisite". The controller validates
--  this graph, starts prerequisites first, and stops users first.
function Depends_On (Child, Prerequisite : Service) return Boolean is
  ((Child = Cache and then Prerequisite = Database)
   or else (Child = API and then Prerequisite = Cache));

function Specification (Child : Service)
  return Child_Specification is
begin
   case Child is
      when Database =>
         return
           (--  Begin recovery after an exception, abort, timeout, or startup
            --  failure, but not after ordinary return or supervisor shutdown.
            Restart           => On_Failure,

            --  A database replacement also replaces Cache and API because
            --  they transitively depend on it. Telemetry remains running.
            Impact            => Restart_Dependents,

            --  Charge the whole dependent-recovery cascade to this one finite
            --  incident budget rather than admitting each child separately.
            Recovery          => Shared_Recovery,

            --  Cooperatively stop each affected task, with no default Ada
            --  abort request, and preserve a still-live task as stuck.
            Stopping          => Default_Stop_Policy,

            --  Database must become ready within 5 seconds before Cache may
            --  start; the same rule applies to each dependent's own policy.
            Readiness_Timeout => Ada.Real_Time.Seconds (5),

            --  The application promises a fresh Database generation can
            --  safely reacquire resources after the old one has finalized.
            Restart_Safe      => True,

            --  Record that Database is an ordinary native task. Native tasks
            --  have no Flyology lightweight execution-group metadata.
            Task_Model        => Flyology.Native_Task,
            Has_Group         => False,

            --  Group is ignored when Has_Group is False; zero is an explicit
            --  placeholder for this full record aggregate.
            Group             => 0);
      when Cache | API | Telemetry =>
         --  Each remaining service supplies the same fields through its own
         --  typed policy function.
         return Service_Policy (Child);
   end case;
end Specification;

--  This relation is consulted only by Restart_Cohort. It can name a recovery
--  set that is not derived from dependency edges.
function Cohort_Member (Trigger, Member : Service) return Boolean is
  (Trigger = Database and then Member in Database | Cache | API);

--  Every family slot uses this task type and the same restart policy.
--  Input points to the generation owner's stable immutable request copy.
task type Session_Task
  (State   : not null access Session_Context;
   Input   : not null access constant Session_Request;
   Control : not null access Generation_Control)
with CPU => 6 is
   pragma Task_Info (Flyology.Lightweight_Task);
   entry Start;
end Session_Task;

--  Session_Task keeps its own body, entries, aspects, and package operations.
function Create
  (State   : not null access Session_Context;
   Input   : not null access constant Session_Request;
   Control : not null access Generation_Control) return Session_Task
is
begin
   --  Choose all task discriminants here. The result is built directly under
   --  the generation's local Ada master and is never copied.
   return Subject : Session_Task (State, Input, Control);
end Create;

procedure Initialize_Session
  (Subject : in out Session_Task;
   Control : aliased in out Generation_Control)
is
   pragma Unreferenced (Control);
begin
   --  Complete the task-specific startup rendezvous after activation and
   --  outside supervisor locks. The task reports readiness only after any
   --  generation-owned resources are actually usable.
   Subject.Start;
end Initialize_Session;

--  The input-aware generation owner keeps Input alive until Session_Task
--  terminates, finalizes, and joins.
--  Define the same Task_Identity and Abort_Task adapters shown above. Their
--  conventional names, and Create, are inferred. Initialize_Session remains
--  explicit because omission means no post-activation hook.
package Session_Generation is new
  Flyology.Supervision.Input_Task_Generations
    (--  Run copies one request into stable storage that outlives the task and
     --  is exposed through Session_Task's read-only Input discriminant.
     Input_Type          => Session_Request,

     --  Shared mutable application state is borrowed for the generation and
     --  must remain alive until Session_Generation.Run returns.
     Application_Context => Session_Context,

     --  This is the exact application task type constructed by the inferred
     --  Create function; Flyology does not replace its body, entries, or
     --  aspects.
     Generation_Task     => Session_Task,

     --  After activation, perform the Start rendezvous defined above. The null
     --  default would skip this task-specific startup hook.
     Initialize          => Initialize_Session);

procedure Run_Session_Generation
  (Context : aliased in out Session_Context;
   Input   : Session_Request;
   Control : aliased in out Generation_Control;
   Result  : out Generation_Result) is
begin
   --  Families calls this once for initial admission and again for an admitted
   --  replacement of the same logical slot.
   Session_Generation.Run (Context, Input, Control, Result);
end Run_Session_Generation;

--  Slot, manager, and event storage are all bounded by generic capacities.
package Sessions is new Flyology.Supervision.Families
  (--  One typed value is copied and retained for each admitted generation.
   Request             => Session_Request,

   --  Shared family state is borrowed from Sessions.Run and outlives every
   --  slot manager and task generation owned by that call.
   Application_Context => Session_Context,

   --  This synchronous operation constructs, observes, and joins exactly one
   --  Session_Task generation for initial start or admitted replacement.
   Run_One_Generation  => Run_Session_Generation,

   --  Every slot uses the same restart, readiness, stopping, and task model.
   Policy              => Session_Policy,

   --  Slot 1 receives this logical id; later slots use the following ids in
   --  one contiguous range. Reuse changes generation, not logical id.
   First_Child_Id      => 10_000_000_000,

   --  At most this many slots may be occupied. The same bound limits the
   --  lazily allocated persistent manager set and makes storage linear.
   Maximum_Children    => 100_000,

   --  Managers share this exact selectable group (1 .. 127). Zero would mean
   --  automatic Ada placement and is rejected. Session_Task remains in 6.
   Control_Group       => 127,

   --  Retain this many decisions for the whole family; new events overwrite
   --  the oldest entries and readers receive the exact dropped count.
   Event_Capacity      => 1_024);

Owner.Start; -- Owner calls Sessions.Run synchronously.

--  Start reserves one slot and returns authority for its exact generation.
Sessions.Start (Family, Request, Exact_Handle);

--  This cannot stop a replacement after termination or slot reuse because
--  Stop requires the exact generation to remain live.
Sessions.Stop (Family, Exact_Handle);

--  Latest is observational lookup by logical slot, not mutation authority.
Latest := Sessions.Latest
  (Family, Flyology.Supervision.Child (Exact_Handle));

--  Constrain the pool discriminants once for this logical child. Every
--  replacement receives a newly constructed Pool_Service object.
type Pool_Service is limited record
   Pool : Jobs.Pool (Worker_Count => 4, Queue_Capacity => 128);
end record;

function Create
  (Context : not null access Worker_Context) return Pool_Service is
begin
   --  Limited build-in-place construction prevents accidental service copies.
   return Item : Pool_Service;
end Create;

procedure Run_Service
  (Item    : in out Pool_Service;
   Context : aliased in out Worker_Context) is
begin
   --  This remains the existing blocking, structured worker-pool call.
   Jobs.Run (Item.Pool, Context);
end Run_Service;

procedure Request_Shutdown (Item : in out Pool_Service) is
begin
   --  The adapter invokes this once when generation cancellation is observed.
   Jobs.Request_Shutdown (Item.Pool);
end Request_Shutdown;

function Ready (Item : Pool_Service) return Boolean is
  (Jobs.Current (Item.Pool).Running);

package Pool_Generation is new Flyology.Supervision.Adapters
  (Application_Context => Worker_Context,
   Service             => Pool_Service,
   --  Create, Run_Service, Request_Shutdown, and Ready are inferred by name.
   Generation_Model    => Flyology.Native_Task);

--  Use Pool_Generation.Run as Run_One_Generation for a static child. A server
--  adapter follows the same shape: Create a fresh Server, acquire a fresh
--  listener inside Run_Service, call Serve, and read Current.Running in Ready.
--  A bare listener loop can expose the same four typed operations.

procedure Application_Main is
   Context    : aliased Application_Context;
   Supervisor : aliased Application_Supervision.Supervisor;
   Result     : Supervisor_Result;

   task Shutdown_Watcher;

   task body Shutdown_Watcher is
   begin
      --  Wait_For_Shutdown must be an application-provided, cancelable bridge
      --  from platform notification into an ordinary Ada task context.
      Wait_For_Shutdown;
      Application_Supervision.Request_Shutdown (Supervisor);
   end Shutdown_Watcher;
begin
   --  The environment task owns the root Ada master. Run returns only after
   --  structured join, whether shutdown or terminal escalation ended it.
   Application_Supervision.Run (Supervisor, Context, Result);

   --  A terminal child result may win before a process shutdown notification.
   --  Cancel and join the watcher before application context can finalize.
   abort Shutdown_Watcher;

   --  Consume the one-shot terminal result before Context finalizes.
   case Result.Outcome is
      when Shutdown_Completed =>
         Set_Exit_Status (Success);
      when Startup_Failed | Recovery_Exhausted | Failure_Escalated =>
         Render_Root_Failure (Result);
         Set_Exit_Status (Failure);
      when Child_Stuck =>
         --  Run cannot reach this branch while the dependent task is live.
         Render_Root_Failure (Result);
         Set_Exit_Status (Failure);
   end case;
end Application_Main;

--  Cursor is caller-owned, so each observer advances independently.
Cursor  : Event_Sequence := 0;
Events  : Supervisor_Event_Array (1 .. 64);
Count   : Natural;
Dropped : Event_Sequence;

--  The protected controller only copies bounded event values into Events.
Services.Read_Events
  (Supervisor, Cursor, Events, Count, Dropped);

--  Formatting and logging happen after the protected action returns.
for Index in 1 .. Count loop
   Render_Outside_The_Controller (Events (Index));
end loop;