commit 9c725c3ec72abeb9fbf56a3336971d37044285dd · patrick.sirref.org/shelter

+1

dune-project

···

       26
       26
        
          cid

     

       27
       27
        
          ppx_repr

     

       28
       28
        
          irmin-fs

     

       29
       29
       +
          cmdliner

     

       29
       30
        
         )

     

       30
       31
        
        (tags

     

       31
       32
        
         ("shell")))

+1

shelter.opam

···

       17
       17
        
         "cid"

     

       18
       18
        
         "ppx_repr"

     

       19
       19
        
         "irmin-fs"

     

       20
       20
       +
         "cmdliner"

     

       20
       21
        
         "odoc" {with-doc}

     

       21
       22
        
       ]

     

       22
       23
        
       build: [

+37 -8

src/bin/main.ml

···

       15
       15
        
         Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 path;

     

       16
       16
        
         path

     

       17
       17
        
       

     

       18
       18
       +
       (* Command Line *)

     

       19
       19
       +
       open Cmdliner

     

       20
       20
       +
       

     

       21
       21
       +
       let main =

     

       22
       22
       +
         let run config =

     

       23
       23
       +
           Eio_posix.run @@ fun env ->

     

       24
       24
       +
           let dir = state_dir env#fs "shelter" in

     

       25
       25
       +
           Shelter.main config env#fs env#clock env#process_mgr dir

     

       26
       26
       +
         in

     

       27
       27
       +
         let t = Term.(const run $ Shelter_main.config_term) in

     

       28
       28
       +
         let man =

     

       29
       29
       +
           [

     

       30
       30
       +
             `P

     

       31
       31
       +
               "Shelter is a shell session shim to help control uncertainty when \

     

       32
       32
       +
                working from the terminal";

     

       33
       33
       +
           ]

     

       34
       34
       +
         in

     

       35
       35
       +
         let doc = "Shelter: version-controlled shell sessions" in

     

       36
       36
       +
         let info = Cmd.info ~man ~doc "main" in

     

       37
       37
       +
         (Cmd.v info t, t, info)

     

       38
       38
       +
       

     

       39
       39
       +
       let passthrough =

     

       40
       40
       +
         let run config =

     

       41
       41
       +
           Eio_posix.run @@ fun env ->

     

       42
       42
       +
           let dir = state_dir env#fs "passthrough" in

     

       43
       43
       +
           Pass.main config env#fs env#clock env#process_mgr dir

     

       44
       44
       +
         in

     

       45
       45
       +
         let t = Term.(const run $ Shelter_passthrough.config_term) in

     

       46
       46
       +
         let info = Cmd.info "passthrough" in

     

       47
       47
       +
         Cmd.v info t

     

       48
       48
       +
       

     

       49
       49
       +
       let cmds =

     

       50
       50
       +
         let cmd, term, info = main in

     

       51
       51
       +
         let cmds = [ cmd; passthrough ] in

     

       52
       52
       +
         Cmd.group ~default:term info cmds

     

       53
       53
       +
       

     

       18
       54
        
       let () =

     

       19
       19
       -
         Eio_posix.run @@ fun env ->

     

       20
       55
        
         Fmt_tty.setup_std_outputs ();

     

       21
       21
       -
         match Sys.argv.(1) with

     

       22
       22
       -
         | "passthrough" ->

     

       23
       23
       -
             let dir = state_dir env#fs "passthrough" in

     

       24
       24
       -
             Pass.main env#fs env#clock env#process_mgr dir

     

       25
       25
       -
         | _ | (exception Invalid_argument _) ->

     

       26
       26
       -
             let dir = state_dir env#fs "shelter" in

     

       27
       27
       -
             Shelter.main env#fs env#clock env#process_mgr dir

     

       56
       56
       +
         exit (Cmd.eval cmds)

+1 -1

src/lib/dune

···

       1
       1
        
       (library

     

       2
       2
        
        (name shelter)

     

       3
       3
        
        (public_name shelter)

     

       4
       4
       -
        (libraries irmin-fs.unix eio.unix eio linenoise void repr))

     

       4
       4
       +
        (libraries cmdliner irmin-fs.unix eio.unix eio linenoise void repr))

+7

src/lib/engine.ml

···

       1
       1
        
       module type S = sig

     

       2
       2
       +
         type config

     

       3
       3
       +
         (** A configuration *)

     

       4
       4
       +
       

     

       5
       5
       +
         val config_term : config Cmdliner.Term.t

     

       6
       6
       +
         (** A cmdliner term for constructing a config *)

     

       7
       7
       +
       

     

       2
       8
        
         type action

     

       3
       9
        
         (** An action to run *)

     

       4
       10
        
       

     
···

       20
       26
        
             to setup history completions etc. with LNoise. *)

     

       21
       27
        
       

     

       22
       28
        
         val run :

     

       29
       29
       +
           config ->

     

       23
       30
        
           _ Eio.Path.t ->

     

       24
       31
        
           _ Eio.Time.clock ->

     

       25
       32
        
           Eio_unix.Process.mgr_ty Eio_unix.Process.mgr ->

+5 -1

src/lib/passthrough/shelter_passthrough.ml

···

       1
       1
        
       open Eio

     

       2
       2
        
       

     

       3
       3
       +
       type config = unit

     

       4
       4
       +
       

     

       5
       5
       +
       let config_term = Cmdliner.Term.const ()

     

       6
       6
       +
       

     

       3
       7
        
       type action = Exec of string [@@deriving repr]

     

       4
       8
        
       

     

       5
       9
        
       let action = action_t

     
···

       33
       37
        
             in

     

       34
       38
        
             List.iter (fun v -> LNoise.history_add v |> ignore) entries

     

       35
       39
        
       

     

       36
       36
       -
       let run _fs clock proc

     

       40
       40
       +
       let run (() : config) _fs clock proc

     

       37
       41
        
           ( ((Shelter.History.Store ((module S), store) : entry Shelter.History.t) as

     

       38
       42
        
              full_store),

     

       39
       43
        
             () ) (Exec command) =

+4 -4

src/lib/shelter.ml

···

       4
       4
        
       module Make (H : History.S) (Engine : Engine.S with type entry = H.t) = struct

     

       5
       5
        
         module Store = Irmin_fs_unix.KV.Make (H)

     

       6
       6
        
       

     

       7
       7
       -
         let run fs clock proc store =

     

       7
       7
       +
         let run config fs clock proc store =

     

       8
       8
        
           let store = History.Store ((module Store), store) in

     

       9
       9
        
           let initial_ctx = Engine.init fs proc store in

     

       10
       10
        
           let rec loop store ctx exit_code =

     
···

       13
       13
        
             | None -> ()

     

       14
       14
        
             | Some input -> (

     

       15
       15
        
                 let action = Engine.action_of_command input in

     

       16
       16
       -
                 match Engine.run fs clock proc (store, ctx) action with

     

       16
       16
       +
                 match Engine.run config fs clock proc (store, ctx) action with

     

       17
       17
        
                 | Error (Eio.Process.Child_error exit_code) ->

     

       18
       18
        
                     Fmt.epr "%a\n%!" Eio.Process.pp_status exit_code;

     

       19
       19
        
                     loop store ctx exit_code

     
···

       24
       24
        
           in

     

       25
       25
        
           loop store initial_ctx (`Exited 0)

     

       26
       26
        
       

     

       27
       27
       -
         let main fs clock proc directory =

     

       27
       27
       +
         let main config fs clock proc directory =

     

       28
       28
        
           Irmin_fs.run directory @@ fun () ->

     

       29
       29
        
           let conf = Irmin_fs.config (Eio.Path.native_exn directory) in

     

       30
       30
        
           let repo = Store.Repo.v conf in

     

       31
       31
        
           let store = Store.main repo in

     

       32
       32
       -
           run fs clock proc store

     

       32
       32
       +
           run config fs clock proc store

     

       33
       33
        
       end

+15

src/lib/shelter/config.ml

···

       1
       1
       +
       type t = { no_diffing : bool; no_ebpf : bool }

     

       2
       2
       +
       

     

       3
       3
       +
       let cmdliner =

     

       4
       4
       +
         let open Cmdliner in

     

       5
       5
       +
         let no_diffing =

     

       6
       6
       +
           let doc = "Disable diffing." in

     

       7
       7
       +
           Arg.(value & flag & info [ "no-diffing" ] ~doc)

     

       8
       8
       +
         in

     

       9
       9
       +
         let no_ebpf =

     

       10
       10
       +
           let doc = "Disable eBPF." in

     

       11
       11
       +
           Arg.(value & flag & info [ "no-ebpf" ] ~doc)

     

       12
       12
       +
         in

     

       13
       13
       +
         Term.(

     

       14
       14
       +
           const (fun no_diffing no_ebpf -> { no_diffing; no_ebpf })

     

       15
       15
       +
           $ no_diffing $ no_ebpf)

+6 -2

src/lib/shelter/shelter_main.ml

···

       23
       23
        
         let merge = Irmin.Merge.(default (Repr.option t))

     

       24
       24
        
       end

     

       25
       25
        
       

     

       26
       26
       +
       type config = Config.t

     

       27
       27
       +
       

     

       28
       28
       +
       let config_term = Config.cmdliner

     

       29
       29
       +
       

     

       26
       30
        
       type entry = History.t

     

       27
       31
        
       

     

       28
       32
        
       type action =

     
···

       168
       172
        
           (list s);

     

       169
       173
        
         store

     

       170
       174
        
       

     

       171
       171
       -
       let run _fs clock _proc (((H.Store ((module S), store) : entry H.t) as s), ctx)

     

       172
       172
       -
           = function

     

       175
       175
       +
       let run (_config : config) _fs clock _proc

     

       176
       176
       +
           (((H.Store ((module S), store) : entry H.t) as s), ctx) = function

     

       173
       177
        
         | Set_mode mode ->

     

       174
       178
        
             with_latest ~default:(fun _ -> Ok (s, ctx)) s @@ fun (_, entry) ->

     

       175
       179
        
             commit ~message:"mode change" clock s { entry with mode };