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
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 : unit -> unit Lwt.t
; after_stop : unit -> unit Lwt.t
}
let empty =
{ services = []
; before_start = (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_stop after_stop app = { app with after_stop }
let starting_commands service =
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 =
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
let* file_configuration = Configuration.read_env_file () in
Configuration.store file_configuration;
let* () = app.before_start () in
Configuration.require configurations;
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
;;