open Core let file_header filename = Printf.sprintf " +----------------------------------------------------------------+ | QMC=Chem | +----------------------------------------------------------------+ Editing file `%s` " filename let make_header s = let l = String.length s in "\n\n"^s^"\n"^(String.init l ~f:(fun _ -> '='))^"\n\n" type field = | Block_time | Walk_num | Walk_num_tot | Stop_time | Fitcusp_factor | Method | Sampling | Ref_energy | Trial_wf_energy | CI_threshold | Time_step | SRMC_projection_time | Jastrow_type | Properties let get field = let option_to_string read to_string doc = let value = read () |> to_string in Printf.sprintf "%s ::\n\n %s\n\n" doc value in let option_to_string_prop read to_string doc = let value = read () |> to_string in Printf.sprintf "%s :\n\n%s\n\n" doc value in let open Input in match field with | Block_time -> option_to_string Block_time.read Block_time.to_string Block_time.doc | Walk_num -> option_to_string Walk_num.read Walk_num.to_string Walk_num.doc | Walk_num_tot -> option_to_string Walk_num_tot.read Walk_num_tot.to_string Walk_num_tot.doc | Stop_time -> option_to_string Stop_time.read Stop_time.to_string Stop_time.doc | Fitcusp_factor -> option_to_string Fitcusp_factor.read Fitcusp_factor.to_string Fitcusp_factor.doc | Method -> option_to_string Method.read Method.to_string Method.doc | Sampling -> option_to_string Sampling.read Sampling.to_string Sampling.doc | Ref_energy -> option_to_string Ref_energy.read Ref_energy.to_string Ref_energy.doc | Trial_wf_energy -> option_to_string Trial_wf_energy.read Trial_wf_energy.to_string Trial_wf_energy.doc | CI_threshold -> option_to_string CI_threshold.read CI_threshold.to_string CI_threshold.doc | Time_step -> option_to_string Time_step.read Time_step.to_string Time_step.doc | SRMC_projection_time -> option_to_string SRMC_projection_time.read SRMC_projection_time.to_string SRMC_projection_time.doc | Jastrow_type -> option_to_string Jastrow_type.read Jastrow_type.to_string Jastrow_type.doc | Properties -> option_to_string_prop Properties.read Properties.to_string Properties.doc let create_temp_file ?temp_filename ezfio_filename fields = let filename = match temp_filename with | None -> Filename.temp_file "qmcchem_edit_" ".rst" | Some name -> name in Out_channel.with_file filename ~f:(fun out_channel -> (file_header ezfio_filename) :: (List.map ~f:get fields) |> String.concat ~sep:"\n" |> Out_channel.output_string out_channel ) ; filename (** Write the input file corresponding to the MD5 key *) let write_input_in_ezfio ezfio_filename fields = let dirname = Lazy.force Md5.input_directory in let temp_filename = Md5.hash () |> Filename.concat dirname in let input_filename = create_temp_file ~temp_filename ezfio_filename fields in assert (Sys.file_exists_exn input_filename) (** Run the edit command *) let run ~c ?f ?t ?l ?m ?e ?et ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_filename = let interactive = ref ( if c then false else true ) in (* Open EZFIO *) Qputils.set_ezfio_filename ezfio_filename; let handle_option (type_conv, write) x = let () = match x with | Some x -> begin type_conv x |> write; interactive := false; end | None -> () in (); in handle_option Input.Ref_energy.(of_float , write) e; handle_option Input.Trial_wf_energy.(of_float , write) et; handle_option Input.Jastrow_type.(of_string, write) j; handle_option Input.Block_time.(of_int , write) l; handle_option Input.Method.(of_string, write) m; handle_option Input.Stop_time.(of_int , write) t; handle_option Input.Sampling.(of_string, write) s; handle_option Input.Fitcusp_factor.(of_float , write) f; handle_option Input.Time_step.(of_float , write) ts; handle_option Input.Walk_num.(of_int , write) w; handle_option Input.Walk_num_tot.(of_int , write) wt; handle_option Input.CI_threshold.(of_float , write) n; handle_option Input.SRMC_projection_time.(of_float , write) p; let fields = [ Stop_time ; Block_time ; Method ; Sampling ; Time_step ; SRMC_projection_time ; Ref_energy ; Trial_wf_energy ; Walk_num ; Walk_num_tot ; Fitcusp_factor ; CI_threshold ; Jastrow_type ; Properties ; ] in if (!interactive) then begin let temp_filename = create_temp_file ezfio_filename fields in let () = match input with | Some filename -> begin if (not !interactive) then failwith "Input file not allowed with command line arguments" else begin Printf.sprintf "cp %s %s" filename temp_filename |> Sys.command_exn ; end end | None -> begin (* Open the temp file with external editor *) let editor = match Sys.getenv "EDITOR" with | Some editor -> editor | None -> "vi" in Printf.sprintf "%s %s ; tput sgr0 2> /dev/null" editor temp_filename |> Sys.command_exn end in (* Re-read the temp file *) let re_data = Str.regexp " .+ *$" and re_prop = Str.regexp "([ xX]) .*$" and raw_data = In_channel.with_file temp_filename ~f:In_channel.input_lines in let data = ( List.filter raw_data ~f:(fun x -> Str.string_match re_data x 0) |> List.map ~f:String.strip ) @ [ List.filter raw_data ~f:(fun x -> Str.string_match re_prop x 0) |> List.map ~f:String.strip |> String.concat ~sep:"\n" ] in let open Input in List.iter2_exn data fields ~f:(fun s f -> try begin match f with | Stop_time -> Stop_time.(of_string s |> write) | Fitcusp_factor -> Fitcusp_factor.(of_string s |> write) | Block_time -> Block_time.(of_string s |> write) | Method -> Method.(of_string s |> write) | Ref_energy -> Ref_energy.(of_string s |> write) | Sampling -> Sampling.(of_string s |> write) | Time_step -> Time_step.(of_string s |> write) | SRMC_projection_time -> SRMC_projection_time.(of_string s |> write) | Walk_num -> Walk_num.(of_string s |> write) | Walk_num_tot -> Walk_num_tot.(of_string s |> write) | CI_threshold -> CI_threshold.(of_string s |> write) | Jastrow_type -> Jastrow_type.(of_string s |> write) | Trial_wf_energy -> Trial_wf_energy.(of_string s |> write) | Properties -> Properties.(of_string s |> write) end with | Failure msg -> Printf.eprintf "%s\n" msg ); (* Remove temp_file *) Sys.remove temp_filename; end ; if c then begin let dirname = Filename.concat (Filename.concat ezfio_filename "blocks") (Md5.hash ()) in let rec clean_dir y = match Sys.is_directory y with | `Yes -> Sys.ls_dir y |> List.map ~f:(Filename.concat y) |> List.iter ~f:(function x -> match ( Sys.is_directory x, Sys.is_file x ) with | (`Yes, _) -> clean_dir x | (_, `Yes) -> Sys.remove x | (_,_) -> () ); Unix.rmdir y | `Unknown | `No -> () in clean_dir dirname; Printf.printf "Blocks cleared\n" end ; Input.validate (); Md5.reset_hash (); write_input_in_ezfio ezfio_filename fields let spec = let open Command.Spec in empty +> flag "c" no_arg ~doc:(" Clear blocks") +> flag "f" (optional float) ~doc:("float "^Input.Fitcusp_factor.doc) +> flag "t" (optional int) ~doc:("seconds "^Input.Stop_time.doc) +> flag "l" (optional int) ~doc:("seconds "^Input.Block_time.doc) +> flag "m" (optional string) ~doc:("method "^Input.Method.doc) +> flag "e" (optional float) ~doc:("energy "^Input.Ref_energy.doc) +> flag "et" (optional float) ~doc:("energy "^Input.Trial_wf_energy.doc) +> flag "s" (optional string) ~doc:("sampling "^Input.Sampling.doc) +> flag "ts" (optional float) ~doc:("time_step "^Input.Time_step.doc) +> flag "w" (optional int) ~doc:("walk_num "^Input.Walk_num.doc) +> flag "wt" (optional int) ~doc:("walk_num_tot "^Input.Walk_num_tot.doc) +> flag "n" (optional float) ~doc:("norm "^Input.CI_threshold.doc) +> flag "j" (optional string) ~doc:("jastrow_type "^Input.Jastrow_type.doc) +> flag "p" (optional float) ~doc:("projection_time "^Input.SRMC_projection_time.doc) +> anon ("ezfio_file" %: string) +> anon (maybe ("input" %: string)) ;; let command = Command.basic ~summary: "Edit input data" ~readme:(fun () -> " Edit input data ") spec (fun c f t l m e et s ts w wt n j p ezfio_file input () -> run ~c ?f ?t ?l ?m ?e ?et ?s ?ts ?w ?wt ?n ?j ?p ?input ezfio_file )