Raw File
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2023 Nomadic Labs <contact@nomadic-labs.com>                *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Jingoo.Jg_types

type item = Global_variables.var

type items = item list

type with_items = Seq of items | Prod of items list

let items_encoding =
  let c = Helpers.make_mk_case () in
  Data_encoding.(
    union
      [
        c.mk_case
          "singleton"
          Global_variables.var_encoding
          (function [x] -> Some x | _ -> None)
          (fun x -> [x]);
        c.mk_case "list" (list Global_variables.var_encoding) Option.some Fun.id;
      ])

let with_items_encoding =
  let c = Helpers.make_mk_case () in
  Data_encoding.(
    union
      [
        c.mk_case
          "seq"
          items_encoding
          (function Seq l -> Some l | _ -> None)
          (fun l -> Seq l);
        c.mk_case
          "prod"
          (obj1 (req "product" (list items_encoding)))
          (function Prod p -> Some p | _ -> None)
          (fun p -> Prod p);
      ])

type header = {
  name : string;
  with_items : with_items option;
  mode : Execution_params.mode;
  vars_updates : Global_variables.update list;
}

type 'uri body =
  | Remote_procedure of {procedure : 'uri Remote_procedure.packed}
  | Copy of {source : string; destination : string}

type 'uri t = {header : header; body : 'uri body}

let header_encoding =
  Data_encoding.(
    conv
      (fun {name; with_items; mode; vars_updates} ->
        (name, with_items, mode, vars_updates))
      (fun (name, with_items, mode, vars_updates) ->
        {name; with_items; mode; vars_updates})
      (obj4
         (req "name" string)
         (opt "with_items" with_items_encoding)
         (dft "run_items" Execution_params.mode_encoding Sequential)
         (dft "vars_updates" Global_variables.updates_encoding [])))

let encoding uri_encoding =
  let c = Helpers.make_mk_case () in
  Data_encoding.(
    delayed @@ fun () ->
    union
      [
        c.mk_case
          "remote_procedure"
          (Remote_procedure.merged_encoding header_encoding uri_encoding)
          (function
            | {header; body = Remote_procedure {procedure}} ->
                Some (header, procedure)
            | _ -> None)
          (fun (header, procedure) ->
            {header; body = Remote_procedure {procedure}});
        c.mk_case
          "copy"
          (merge_objs
             header_encoding
             (obj1
                (req
                   "copy"
                   (obj2 (req "local_path" string) (req "remote_path" string)))))
          (function
            | {header; body = Copy {source; destination}} ->
                Some (header, (source, destination))
            | _ -> None)
          (fun (header, (source, destination)) ->
            {header; body = Copy {source; destination}});
      ])

let expand_body ~self ~vars ~agent ~re ~item =
  let run = Template.run ~vars ~agent ~re ~item ~res:Tnull in
  function
  | Remote_procedure {procedure} ->
      Remote_procedure
        {
          procedure =
            Remote_procedure.expand ~self ~vars ~agent ~re ~item procedure;
        }
  | Copy {source; destination} ->
      let source = run source in
      let destination = run destination in
      Copy {source; destination}

let expand_item ~vars ~agent ~re def =
  match Global_variables.tvalue_of_var def with
  | Tstr def -> (
      let def = Template.run ~vars ~agent ~re ~item:Tnull ~res:Tnull def in
      match def =~** rex {|(\d+)\.\.(\d+)|} with
      | Some (range_from, range_to) ->
          let range_from = int_of_string range_from in
          let range_to = int_of_string range_to in
          Seq.init (range_to - range_from + 1) (fun x -> Tint (range_from + x))
      | None -> (
          match int_of_string_opt def with
          | Some i -> Seq.return (Tint i)
          | None -> (
              match bool_of_string_opt def with
              | Some b -> Seq.return (Tbool b)
              | None -> Seq.return (Tstr def))))
  | x -> Seq.return x
back to top