(* * Copyright (c) 2013-2020 Thomas Gazagnaire * Copyright (c) 2013-2020 Anil Madhavapeddy * Copyright (c) 2015-2020 Gabriel Radanne * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *) open Astring open Action.Syntax let src = Logs.Src.create "functoria.cache" ~doc:"functoria library" module Log = (val Logs.src_log src : Logs.LOG) type t = string array let empty = [| "" |] let is_empty t = t = empty let write file argv = Log.info (fun m -> m "Preserving arguments in %a:@ %a" Fpath.pp file Fmt.Dump.(array string) argv); (* Only keep args *) let args = List.tl (Array.to_list argv) in let args = List.map String.Ascii.escape args in let args = String.concat ~sep:"\n" args ^ "\n" in Action.write_file file args let read file = Log.info (fun l -> l "reading cache %a" Fpath.pp file); let* is_file = Action.is_file file in if not is_file then Action.ok empty else let* args = Action.read_file file in let args = String.cuts ~sep:"\n" args in (* remove trailing '\n' *) let args = List.rev (List.tl (List.rev args)) in (* Add an empty command *) let args = "" :: args in let args = Array.of_list args in try let args = Array.map (fun x -> match String.Ascii.unescape x with | Some s -> s | None -> Fmt.failwith "%S: cannot parse" x) args in Action.ok args with Failure e -> Action.error e let peek t term = match Cmdliner.Cmd.eval_peek_opts ~argv:t term with | Some c, _ | _, Ok (`Ok c) -> Some c | _ -> None let merge t term = let cache = match peek t term with None -> Context.empty | Some c -> c in let f term = Context.merge ~default:cache term in Cmdliner.Term.(const f $ term) let peek_output t = Cli.peek_output t let file ~name args = let build_dir = Fpath.parent args.Cli.config_file in match args.Cli.context_file with | Some f -> f | None -> Fpath.(build_dir / name / "context")