You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
118 lines
3.5 KiB
118 lines
3.5 KiB
(*
|
|
Cloud storage API:
|
|
- you can open paths for reading
|
|
(there are several ways to read, but we only discuss read_all which reads the whole content)
|
|
- when a channel is closed, the API returns a "cost" which
|
|
corresponds to some resource consumption accumulated by
|
|
all operations on the file.
|
|
*)
|
|
|
|
|
|
type 'a cloud
|
|
(* applicative combinators *)
|
|
val pure : 'a -> 'a cloud
|
|
val map : ('a -> 'b) -> 'a cloud -> 'b cloud
|
|
val pair : 'a cloud -> 'b cloud -> ('a * 'b) cloud
|
|
|
|
(* effectful operations *)
|
|
val with_input : path -> (in_channel -> 'r cloud) -> (cost * 'r) cloud
|
|
val read_all : in_channel -> string cloud
|
|
|
|
(* binding operators *)
|
|
val (let+) : 'a cloud -> ('a -> 'b) -> 'b cloud
|
|
val (and+) : 'a cloud -> 'b cloud -> ('a * 'b) cloud
|
|
val (let@) : 'a -> ('a -> 'b cloud) -> 'b cloud
|
|
|
|
|
|
(* Now examples *)
|
|
|
|
(* easy *)
|
|
val cat : path -> path -> (cost * string) cloud
|
|
let cat path1 path2 =
|
|
let+ (cost1, (cost2, (s1, s2))) =
|
|
let@ chan1 = with_input path1 in
|
|
let@ chan2 = with_input path2 in
|
|
pair (read_all chan1) (read_all chan2)
|
|
in (cost1 + cost2, s1 ^ s2)
|
|
|
|
(* harder! *)
|
|
val cat_all : path list -> (cost * string) cloud
|
|
|
|
(* solution one: application-specific loop *)
|
|
let cat_all paths cloud =
|
|
let rec loop : path list -> (cost * string) list cloud = function
|
|
| [] -> pure []
|
|
| p :: ps ->
|
|
let+ (cost, (s, rest)) =
|
|
let@ chan = with_input p in
|
|
pair (read_all chan) (loop ps)
|
|
in (cost, s) :: rest
|
|
in
|
|
let+ results = loop paths in
|
|
let costs, inputs = List.split results in
|
|
(List.fold_left (+) 0 costs,
|
|
String.concat "" inputs)
|
|
(* In the loop we decide that we want to read_all on each
|
|
channel, while other users could want to loop over
|
|
paths but do some other operation.
|
|
So this code is not reusable. *)
|
|
|
|
(* Solution two: more generic approach. *)
|
|
let rec with_inputs paths (k : in_channel list -> 'r cloud) : (cost * 'r) cloud =
|
|
match paths with
|
|
| [] ->
|
|
let+ r = k [] in (0, r)
|
|
| p :: ps ->
|
|
let+ (cost_p, (cost_ps, r)) =
|
|
let@ chan = with_input p in
|
|
let@ chans = with_inputs pts in
|
|
k (chan :: chans)
|
|
in (cost_p + cost_ps, r)
|
|
|
|
(* we assume that this combinator has been implemented *)
|
|
val mapM : ('a -> 'b cloud) -> 'a list -> 'b list cloud
|
|
|
|
let cat_all paths =
|
|
let@ chans = with_inputs paths in
|
|
let+ inputs = mapM read_all chans in
|
|
String.concat "" inputs
|
|
|
|
|
|
(* Can we make the generic approach more natural?
|
|
|
|
Our proposed API: turn direct outputs into modal inputs *)
|
|
|
|
val with_input : (channel * cost cloud -> 'r cloud) -> 'r cloud
|
|
|
|
(* or, introducing a concept of "binder" *)
|
|
type ('a, 'r) binder = ('a -> 'r cloud) -> 'r cloud
|
|
val with_input : (in_channel * cost cloud, 'r) binder
|
|
|
|
let rec with_inputs paths : (in_channel list * cost cloud, 'r) binder =
|
|
fun k -> match paths with
|
|
| [] -> k ([], pure 0)
|
|
| p :: ps ->
|
|
let@ chan, cost_p = with_input p in
|
|
let@ chans, cost_ps = with_input ps in
|
|
let+ res = k (p :: ps)
|
|
and+ cost_p = cost_p
|
|
and+ cost_ps = cost_ps
|
|
in (cost_p + cost_ps, res)
|
|
(* notice how 'cost' variables are now declared more locally ,
|
|
making code easier to read.*)
|
|
|
|
(* Note: this approach also increases readability in the non-generic approach *)
|
|
let cat_all paths cloud =
|
|
let rec loop : path list -> (cost * string) list cloud = function
|
|
| [] -> pure []
|
|
| p :: ps ->
|
|
let@ chan, cost = with_input p in
|
|
let+ s = read_all chan
|
|
and+ rest = loop ps
|
|
in (cost, s) :: rest
|
|
in
|
|
let+ results = loop paths in
|
|
let costs, inputs = List.split results in
|
|
(List.fold_left (+) 0 costs,
|
|
String.concat "" inputs)
|