package sihl

  1. Overview
  2. Docs
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file service.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
open Base
module Sig = Sig

let registered_seeds = ref (Map.empty (module String))

exception Exception of string

module Make
    (Log : Log.Service.Sig.SERVICE)
    (CmdService : Cmd.Service.Sig.SERVICE) : Sig.SERVICE = struct
  let register_seed seed =
    registered_seeds :=
      Map.add_exn !registered_seeds ~key:(Seed_core.name seed) ~data:seed

  let register_seeds seeds =
    registered_seeds :=
      List.fold_left seeds ~init:!registered_seeds ~f:(fun m s ->
          Map.add_exn m ~key:(Seed_core.name s) ~data:s)

  let get_seeds () =
    !registered_seeds |> Map.to_alist |> List.map ~f:(fun (_, b) -> b)

  let run_seed ctx name =
    Log.debug (fun m -> m "SEED: Running seed %s" name);
    match Map.find !registered_seeds name with
    | Some seed ->
        let fn = Seed_core.fn seed in
        fn ctx
    | None ->
        Log.err (fun m -> m "SEED: Seed not found: %s" name);
        Log.info (fun m ->
            m
              "SEED: Have you registered the seed? Call \
               SeedService.register_seed or register the seed with the app \
               using App.with_seed.");
        raise @@ Exception "Seed not found"

  let seed_list =
    Cmd.make ~name:"seedlist" ~description:"List all registered seeds"
      ~fn:(fun _ ->
        let seeds = get_seeds () in
        seeds |> List.map ~f:Seed_core.show |> String.concat ~sep:"\n"
        |> Caml.print_endline;
        Lwt.return ())
      ()

  let seed_run =
    Cmd.make ~name:"seedrun" ~help:"<seed name>" ~description:"Run seed"
      ~fn:(fun args ->
        match args with
        | [ name ] ->
            let ctx = Core.Ctx.empty in
            run_seed ctx name
        | _ -> raise (Cmd.Invalid_usage "Usage: <seed name>"))
      ()

  let start ctx =
    CmdService.register_command seed_list;
    CmdService.register_command seed_run;
    Lwt.return ctx

  let stop _ = Lwt.return ()

  let lifecycle = Core.Container.Lifecycle.make "seed" ~start ~stop
end
OCaml

Innovation. Community. Security.