1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
open Base
open Bistro
open Bistro.Template_dsl
type t = template
type expr = t
type arg = t
let make xs = Template_dsl.(seq ~sep:"\n" xs)
let source s = Template_dsl.string s
let dest = Template_dsl.(quote ~using:'"' dest)
let tmp = Template_dsl.(quote ~using:'"' tmp)
let string s =
Template_dsl.(quote ~using:'"' (string s))
let int i = Template_dsl.int i
let float f = Template_dsl.float f
let dep w = Template_dsl.(quote ~using:'"' (dep w))
let call_gen fn arg xs =
let open Template_dsl in
seq ~sep:"" [
string fn ;
string "(" ;
list ~sep:"," arg xs ;
string ")" ;
]
let call fn args = call_gen fn Fn.id args
let vector f xs = call_gen "c" f xs
let ints xs = vector Template_dsl.int xs
let string_call_gen fn arg xs =
List.map xs ~f:arg
|> String.concat ~sep:","
|> Printf.sprintf "%s(%s)" fn
let ints_dep w =
Workflow.(app (pure (string_call_gen "c" Int.to_string) ~id:"r_script.ints") w)
|> Template_dsl.string_dep
let floats xs = vector Template_dsl.float xs
let floats_dep w =
Workflow.(app (pure (string_call_gen "c" Float.to_string) ~id:"r_script.floats") w)
|> Template_dsl.string_dep
let strings xs = vector string xs
let strings_dep w =
Workflow.(app (pure (string_call_gen "c" (Printf.sprintf "%S")) ~id:"r_script.strings") w)
|> Template_dsl.string_dep
let deps xs = vector dep xs
let arg ?l e =
let open Template_dsl in
match l with
| None -> e
| Some label ->
seq ~sep:"" [ string label ; string "=" ; e ]
let assign var e =
let open Template_dsl in
seq ~sep:" " [ string var ; string "<-" ; e ]
let workflow ?descr ?np ?mem ?img script =
Workflow.shell ?descr ?img ?np ?mem Shell_dsl.[
cmd "Rscript" [ file_dump script ] ;
]
let workflow' ?descr ?np ?mem ?img exprs =
workflow ?descr ?np ?mem ?img (make exprs)