package sihl

  1. Overview
  2. Docs
The modular functional web framework

Install

Dune Dependency

Authors

Maintainers

Sources

sihl-queue-0.1.7.tbz
sha256=a432c28b88610b8ef914aa93d1be5bf3ad4b357ebaa8e95848e981ea30611cd4
sha512=e85a2c2935973826ef29191d6a784dca53660c8df55a98174d7326a8a73865cf7f35bfae034b179d85f30bb809985da3c6d170608da2e9ac9763b8fd1f8a1a4e

doc/src/sihl.core/app.ml.html

Source file app.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
open Lwt.Syntax

let log_src = Logs.Src.create ~doc:"Sihl app" "sihl.app"

module Logger = (val Logs.src_log log_src : Logs.LOG)

type t =
  { services : Container.Service.t list
  ; before_start : Ctx.t -> unit Lwt.t
  ; after_start : Ctx.t -> unit Lwt.t
  ; before_stop : Ctx.t -> unit Lwt.t
  ; after_stop : Ctx.t -> unit Lwt.t
  }

let empty =
  { services = []
  ; before_start = (fun _ -> Lwt.return ())
  ; after_start = (fun _ -> Lwt.return ())
  ; before_stop = (fun _ -> Lwt.return ())
  ; after_stop = (fun _ -> Lwt.return ())
  }
;;

let with_services services app = { app with services }
let before_start before_start app = { app with before_start }
let after_start after_start app = { app with after_start }
let before_stop before_stop app = { app with before_stop }
let after_stop after_stop app = { app with after_stop }

(* TODO [jerben] 0. store ref to current app and start ctx 1. loop forever (in
   Lwt_main.run) 2. when command finishes, exit loop 3. when SIGINT comes, exit loop 4.
   call stop app let stop app ctx = let* () = app.before_stop ctx in print_endline "CORE:
   Stop services"; let* () = Container.stop_services ctx app.services in print_endline
   "CORE: Services stopped"; app.after_stop ctx *)

let starting_commands service =
  (* When executing a starting command, the service that publishes that command and all
     its dependencies is started before the command is run *)
  List.map
    (fun command ->
      let fn args =
        let* _ = Container.start_services [ service ] in
        command.Command.fn args
      in
      Command.{ command with fn })
    (Container.Service.commands service)
;;

let run' ?(commands = []) ?(log_reporter = Log.default_reporter) ?args app =
  (* Set the logger up as first thing so we can log *)
  Logs.set_reporter (log_reporter ());
  Logger.debug (fun m -> m "Setup service configurations");
  let configurations =
    List.map (fun service -> Container.Service.configuration service) app.services
  in
  List.iter
    (fun configuration -> configuration |> Configuration.data |> Configuration.store)
    configurations;
  let* file_configuration = Configuration.read_env_file () in
  Configuration.store file_configuration;
  let configuration_commands = Configuration.commands configurations in
  Logger.debug (fun m -> m "Setup service commands");
  let service_commands = app.services |> List.map starting_commands |> List.concat in
  let commands = List.concat [ configuration_commands; service_commands; commands ] in
  Command.run commands args
;;

let run ?(commands = []) ?(log_reporter = Log.default_reporter) ?args app =
  Lwt_main.run
  @@
  match args with
  | Some args -> run' ~commands ~log_reporter ~args app
  | None -> run' ~commands ~log_reporter app
;;
OCaml

Innovation. Community. Security.