case_insensitive_string_sample.ml

(* libraries definitions *)

(* Haskell's Data.Function.on implementation in OCaml *)
module Data : sig
  module Function : sig
    val on : ('b -> 'b -> 'c) -> ('a -> 'b) -> ('a -> 'a -> 'c)
  end
end = struct
  module Function = struct
    let on bf f = fun x y -> bf (f x) (f y)
  end
end

(* list to string *)
module List = struct
  let string_of_list ~f:to_string xs =
    let ys = List.map to_string xs in
    let s = String.concat "; " ys in
    Printf.sprintf "[%s]" s
end

open List

module List = Stdlib.List

(* bool to string *)
module Bool = struct
  let string_of_bool b = if b then "true" else "false"
  let print_bool b = string_of_bool b |> print_string
end

open Bool

(* function composition *)
let (>>) (f : 'a -> 'b) (g : 'b -> 'c) : 'a -> 'c = fun x -> g (f x)

(* core implementation below *)
type case_insens_string = CaseInsens of string

module CaseInsens : sig
  type t = case_insens_string
    
  val pack : string -> t
  val unpack : t -> string
  val (=) : t -> t -> bool
  val compare : t -> t -> int
end = struct
  open Data.Function
  
  type t = case_insens_string
  
  let pack s = CaseInsens s
  let unpack (CaseInsens s) = s
  let (=) = on (=) (unpack >> String.lowercase_ascii)
  let compare = on compare (unpack >> String.lowercase_ascii)
end

(* main *)
let () =
  let open CaseInsens in
  
  let x = pack "aBc" in
  let y = pack "ABc" in
  
  let b1 = x = y in
  print_bool b1 |> print_newline;
  
  let xs =
    ["aBd"; "ABc"; "bAD"; "bAc"]
    |> List.map pack
    |> List.sort compare
  in
  string_of_list ~f:unpack xs |> print_endline

output is:

true
[ABc; aBd; bAc; bAD]