this repo has no description
some morbig
+125
-11
+4
README.md
+4
README.md
+27
-8
src/bin/main.ml
+27
-8
src/bin/main.ml
···
6
6
end
7
7
8
8
module Pass = Shelter.Make (History) (Shelter_passthrough)
9
-
module Shelter = Shelter.Make (Shelter_main.History) (Shelter_main)
9
+
module Main = Shelter.Make (Shelter_main.History) (Shelter_main)
10
10
11
11
let home = Unix.getenv "HOME"
12
12
···
17
17
18
18
(* Command Line *)
19
19
open Cmdliner
20
+
21
+
let cmd_file =
22
+
let doc = "Path to a file containing a series of commands." in
23
+
Arg.(
24
+
value
25
+
& opt (some file) None
26
+
& info [ "f"; "file" ] ~docv:"COMMAND_FILE" ~doc)
20
27
21
28
let main =
22
-
let run config =
29
+
let run config cmd_file =
23
30
Eio_posix.run @@ fun env ->
31
+
let cmd_file = Option.map (Eio.Path.( / ) env#fs) cmd_file in
24
32
let dir = state_dir env#fs "shelter" in
25
-
Shelter.main config env#fs env#clock env#process_mgr dir
33
+
Main.main config env#fs env#clock env#process_mgr dir cmd_file
26
34
in
27
-
let t = Term.(const run $ Shelter_main.config_term) in
35
+
let t = Term.(const run $ Shelter_main.config_term $ cmd_file) in
28
36
let man =
29
37
[
30
38
`P
···
37
45
(Cmd.v info t, t, info)
38
46
39
47
let passthrough =
40
-
let run config =
48
+
let run config cmd_file =
41
49
Eio_posix.run @@ fun env ->
50
+
let cmd_file = Option.map (Eio.Path.( / ) env#fs) cmd_file in
42
51
let dir = state_dir env#fs "passthrough" in
43
-
Pass.main config env#fs env#clock env#process_mgr dir
52
+
Pass.main config env#fs env#clock env#process_mgr dir cmd_file
44
53
in
45
-
let t = Term.(const run $ Shelter_passthrough.config_term) in
54
+
let t = Term.(const run $ Shelter_passthrough.config_term $ cmd_file) in
46
55
let info = Cmd.info "passthrough" in
47
56
Cmd.v info t
48
57
58
+
let extract_commands =
59
+
let run cmd_file =
60
+
Eio_posix.run @@ fun env ->
61
+
let cmd_file = Eio.Path.( / ) env#fs (Option.get cmd_file) in
62
+
Shelter.Script.to_commands cmd_file |> List.iter (Fmt.pr "%s\n")
63
+
in
64
+
let t = Term.(const run $ cmd_file) in
65
+
let info = Cmd.info "extract" in
66
+
Cmd.v info t
67
+
49
68
let cmds =
50
69
let cmd, term, info = main in
51
-
let cmds = [ cmd; passthrough ] in
70
+
let cmds = [ cmd; passthrough; extract_commands ] in
52
71
Cmd.group ~default:term info cmds
53
72
54
73
let () =
+1
-1
src/lib/dune
+1
-1
src/lib/dune
+57
src/lib/script.ml
+57
src/lib/script.ml
···
1
+
module Cst = Morbig.CST
2
+
3
+
let redirect_to_string = function
4
+
| Cst.IoRedirect_IoFile { value = io_file; _ } -> (
5
+
match io_file with
6
+
| Cst.IoFile_Great_FileName
7
+
{ value = Cst.Filename_Word { value = Cst.Word (w, _); _ }; _ } ->
8
+
Fmt.str "> %s" w
9
+
| Cst.IoFile_DGreat_FileName
10
+
{ value = Cst.Filename_Word { value = Cst.Word (w, _); _ }; _ } ->
11
+
Fmt.str ">> %s" w
12
+
| _ -> failwith "Redirect Unsupported")
13
+
| _ -> failwith "IO Redirect Unsupported"
14
+
15
+
let cmd_suffix_to_list s =
16
+
let rec loop = function
17
+
| Cst.CmdSuffix_Word { value = Cst.Word (s, _); _ } -> [ s ]
18
+
| Cst.CmdSuffix_CmdSuffix_Word (suff, { value = Cst.Word (s, _); _ }) ->
19
+
s :: loop suff.value
20
+
| Cst.CmdSuffix_CmdSuffix_IoRedirect (suff, { value = redirect; _ }) ->
21
+
let sf = loop suff.value in
22
+
redirect_to_string redirect :: sf
23
+
| _ -> failwith "Unsupported!"
24
+
in
25
+
loop s |> List.rev |> String.concat " "
26
+
27
+
let of_cmd (c : Cst.command) =
28
+
match c with
29
+
| Cst.Command_SimpleCommand simple -> (
30
+
match simple.value with
31
+
| Cst.SimpleCommand_CmdName
32
+
{ value = Cst.CmdName_Word { value = Cst.Word (w, _); _ }; _ } ->
33
+
w
34
+
| Cst.SimpleCommand_CmdName_CmdSuffix
35
+
( { value = Cst.CmdName_Word { value = Cst.Word (w, _); _ }; _ },
36
+
{ value = suff; _ } ) ->
37
+
let s = cmd_suffix_to_list suff in
38
+
w ^ " " ^ s
39
+
| _ -> failwith "Unsupported")
40
+
| _ -> failwith "Unsupported"
41
+
42
+
let cmds_to_strings =
43
+
let v =
44
+
object
45
+
inherit [_] Morbig.CSTVisitors.reduce
46
+
method zero = []
47
+
method plus = List.append
48
+
method! visit_command acc c = of_cmd c :: acc
49
+
end
50
+
in
51
+
v#visit_program []
52
+
53
+
let to_commands file =
54
+
let contents = Eio.Path.load file in
55
+
let name = Eio.Path.native_exn file |> Filename.basename in
56
+
let ast = Morbig.parse_string name contents in
57
+
cmds_to_strings ast
+32
-2
src/lib/shelter.ml
+32
-2
src/lib/shelter.ml
···
1
1
module History = History
2
2
module Engine = Engine
3
+
module Script = Script
3
4
4
5
module Make (H : History.S) (Engine : Engine.S with type entry = H.t) = struct
5
6
module Store = Irmin_fs_unix.KV.Make (H)
···
24
25
in
25
26
loop store initial_ctx (`Exited 0)
26
27
27
-
let main config fs clock proc directory =
28
+
let command_file_to_actions cf =
29
+
Eio.Path.load cf |> String.split_on_char '\n'
30
+
|> List.map Engine.action_of_command
31
+
32
+
let main config fs clock proc directory command_file =
28
33
Irmin_fs.run directory @@ fun () ->
29
34
let conf = Irmin_fs.config (Eio.Path.native_exn directory) in
30
35
let repo = Store.Repo.v conf in
31
36
let store = Store.main repo in
32
-
run config fs clock proc store
37
+
match command_file with
38
+
| Some file -> (
39
+
let actions = command_file_to_actions file in
40
+
let store = History.Store ((module Store), store) in
41
+
let initial_ctx = Engine.init fs proc store in
42
+
let folder (store, ctx, exit_code) action =
43
+
if exit_code <> `Exited 0 then (store, ctx, exit_code)
44
+
else
45
+
match Engine.run config fs clock proc (store, ctx) action with
46
+
| Error (Eio.Process.Child_error exit_code) ->
47
+
Fmt.epr "%a\n%!" Eio.Process.pp_status exit_code;
48
+
(store, ctx, exit_code)
49
+
| Error (Eio.Process.Executable_not_found m) ->
50
+
Fmt.epr "cshell: excutable not found %s\n%!" m;
51
+
(store, ctx, `Exited 127)
52
+
| Ok (store, ctx) -> (store, ctx, `Exited 0)
53
+
in
54
+
let _store, _ctx, exit_code =
55
+
List.fold_left folder (store, initial_ctx, `Exited 0) actions
56
+
in
57
+
match exit_code with
58
+
| `Exited 0 -> ()
59
+
| `Exited n | `Signaled n ->
60
+
Fmt.epr "%a\n%!" Eio.Process.pp_status exit_code;
61
+
exit n)
62
+
| None -> run config fs clock proc store
33
63
end