fun.ml

module type Arrow =
sig
  type ('a,'b) t
  val arr   : ('a -> 'b) -> ('a, 'b) t
  val (>>>) : ('a,'b) t -> ('b,'c) t -> ('a,'c) t
  val first : ('a,'b) t -> ('a * 'c, 'b * 'c) t
end

module type Arrow_choice =
sig
  include Arrow
  val (<+>) : ('a,'b) t -> ('a,'b) t -> ('a,'b) t
  val apply : ('a,'b) t -> 'a -> 'b
end

module Fun : Arrow_choice =
struct
  type ('a,'b) t = 'a -> 'b

  let arr f = f

  let (>>>) f g = fun x -> g (f x)

  let first f = fun (x,y) -> (f x, y)

  let (<+>) f g =
    fun x -> if Random.bool () then f x else g x

  let apply f = f
end

let () = Random.self_init ()

open Fun

let c1 = arr (fun x -> List.length x > 0)
let c2 = arr (fun y -> Printf.sprintf "%B" y)
let c12 = c1 >>> c2

let c3 = arr (fun l -> String.concat " " (List.map string_of_int l))
let c12or3 = c12 <+> c3

let () = print_endline @@ apply c12or3 [1;2;3]