main.ml

let string_of_list ~to_string xs =
  "[" ^ String.concat "; " (List.map to_string xs) ^ "]"
  
let string_of_opt ~to_string =
  function None -> "None" | Some x -> Printf.sprintf "Some(%s)" @@ to_string x

let () =
  let print_optlist theme xs =
    let xs = OptionList.to_optlist xs in
    let lstr = string_of_list ~to_string:(string_of_opt ~to_string:string_of_int) xs in
    Printf.printf "<%s> %s\n" theme lstr
  in
  
  let xs = OptionList.of_optlist [Some 3; None; Some 5; Some 2] in
  print_optlist "xs" xs ;
  
  (* map *)
  xs
  |> OptionList.map (( * ) 2) 
  |> print_optlist "xs/map" ;
  
  (* return *)
  print_optlist "return" @@ OptionList.return 10 ;
  
  (* apply *)
  let ys =
    let open OptionList in
    xs |> apply @@ of_optlist [Some ((+) 2); None; Some (( * ) 2)]
  in 
  print_optlist "ys/apply" ys ;
  
  (* concat_map *)
  xs
  |> OptionList.(concat_map (fun x -> of_optlist [Some (x + 2); None; Some (x * 2)]))
  |> print_optlist "xs/concat_map" ;
  
  (* filter *)
  xs
  |> OptionList.filter (fun x -> x mod 2 <> 0)
  |> print_optlist "xs/filter" ;

optionList.ml

module OptionList = struct
  type 'a t = 'a optlist
      
  let map f = List.map (Option.map f)
      
  let return x = [Some x]
                 
  let apply fs xs =
    let rec aux acc = function
      | [] -> acc
      | y :: ys ->
          match y with
          | None -> aux acc ys
          | Some y -> aux (map y xs :: acc) ys
    in
    aux [] fs |> List.rev |> List.concat_map Fun.id
      
  let concat_map f = List.concat_map (function None -> [] | Some x -> f x)
      
  let filter f = List.filter (function None -> false | Some x -> f x)
      
  let flatten xs =
    let rec aux acc = function
      | [] -> acc
      | x :: xs ->
          match x with
          | None -> aux acc xs
          | Some x' -> aux (x' :: acc) xs
    in
    aux [] xs |> List.rev
      
  let of_optlist = Fun.id
  let to_optlist = Fun.id
end

optionList.mli

module type OptionList = sig
  type 'a t
  
  val map : ('a -> 'b) -> 'a t -> 'b t
  val return : 'a -> 'a t
  val apply : ('a -> 'b) t -> 'a t -> 'b t
  val concat_map : ('a -> 'b t) -> 'a t -> 'b t
  val filter : ('a -> bool) -> 'a t -> 'a t
  val flatten : 'a t -> 'a list
      
  val of_optlist : 'a optlist -> 'a t
  val to_optlist : 'a t -> 'a optlist
end