this repo has no description
patrick.sirref.org
1(* Work in progress, prototyped in https://try.ocamlpro.com/. To be modified
2 for Base. *)
3
4module type Applicative = sig
5 type 'a t
6
7 val return : 'a -> 'a t
8 val apply : ('a -> 'b) t -> 'a t -> 'b t
9end
10
11module type Selective = sig
12 include Applicative
13
14 val select : ('a, 'b) Either.t t -> ('a -> 'b) t -> 'b t
15end
16
17module Make (S : Selective) = struct
18 include S
19
20 let ( <*? ) x f = S.select x f
21 let map ~f x = apply (return f) x
22
23 let branch x l r =
24 map x ~f:(Either.map ~left:Fun.id ~right:Either.left)
25 <*? map l ~f:(Fun.compose Either.right)
26 <*? r
27
28 let if' x t f =
29 branch
30 (map x ~f:(fun b -> if b then Either.Left () else Either.Right ()))
31 (map t ~f:Fun.const) (map f ~f:Fun.const)
32
33 let when' x act = if' x act (return ())
34 let ( <||> ) a b = if' a (return true) b
35 let ( <&&> ) a b = if' a b (return false)
36end
37
38module type Task = sig
39 type k
40 type v
41
42 val exec : k -> v
43
44 module Make (S : Selective) : sig
45 val run : (k -> v S.t) -> v S.t
46 end
47end
48
49module Example : Task with type k = string and type v = int = struct
50 type k = string
51 type v = int
52
53 let exec s = Sys.command s
54
55 module Make (Select : Selective) = struct
56 module S = Make (Select)
57
58 let run exec =
59 S.if'
60 (S.map (exec "node") ~f:(fun x -> x = 0))
61 (exec "echo 'node!'") (exec "echo 'no node'")
62 end
63end
64
65module Dependencies (Task : Task) : sig
66 val deps : Task.k list
67 val v : Task.v
68end = struct
69 module Ks = Make (struct
70 type 'a t = Task.k List.t
71
72 let return _ = []
73 let apply x y = List.append x y
74 let map = `Define_using_apply
75 let select x y = List.append x y
76 end)
77
78 module Xs : Selective with type 'a t = 'a = struct
79 type 'a t = 'a
80
81 let return v = v
82 let apply f y = f y
83 let map = `Define_using_apply
84
85 let select either f =
86 match either with
87 | Either.Left v ->
88 Format.printf "Either left\n%!";
89 f v
90 | Either.Right b ->
91 Format.printf "Either right\n%!";
92 b
93 end
94
95 module Ys = Make (Xs)
96 module M = Task.Make (Ks)
97 module T = Task.Make (Ys)
98
99 let deps = M.run (fun v -> [ v ])
100 let v = T.run Task.exec
101end
102
103let () =
104 let module D = Dependencies (Example) in
105 (* List.iter (Format.printf "Dep: %s\n%!") D.deps; *)
106 Format.printf "Result: %i\n" D.v