Chapter 5: Records

(* suppose the record type is this:  *)
type service_info =
  { service_name : string;
    port         : int;
    protocol     : string;
    comment      : string option;
  }

(* if warnings for +9 is turned on  *)
let service_info_to_string
  { service_name = name; port = port; protocol = prot  }
  =
  sprintf "%s %i/%s" name port prot
;;
(* Then we can expect this warning:
   Line 2, characters 5-59:
    Warning 9 [missing-record-field-pattern]: the following labels are not bound in this record pattern:
    comment
    Either bind these labels explicitly or add '; _' to the pattern.
    val service_info_to_string : service_info -> string = <fun>
 *)

(* better way to handle fields we don't care about:  *)
let service_info_to_string
  { service_name = name; port = port; protocol = prot; _ }
  =
  sprintf "%s %i/%s" name port prot
;;

(* PUNNING @ CREATION *)
let service_info_of_string line =
  (* first, split off any comment *)
  let (line,comment) =
    match String.rsplit2 line ~on:'#' with
    | None -> (line,None)
    | Some (ordinary,comment) -> (ordinary, Some comment)
  in
  (* now, use a regular expression to break up the
     service definition *)
  let matches =
    Re.exec
      (Re.Posix.compile_pat
         "([a-zA-Z]+)[ \t]+([0-9]+)/([a-zA-Z]+)")
      line
  in
  let service_name = Re.Group.get matches 1 in
  let port = Int.of_string (Re.Group.get matches 2) in
  let protocol = Re.Group.get matches 3 in
  { service_name; port; protocol; comment };; (*punned*)

(* PUNNING @ REFERENCE: Field and label punned version: *)
let create_service_info ~service_name ~port ~protocol ~comment =
  { service_name; port; protocol; comment };;

(* longer version, without punning: *)
let create_service_info
      ~service_name:service_name ~port:port
      ~protocol:protocol ~comment:comment =
  { service_name = service_name;
    port = port;
    protocol = protocol;
    comment = comment;
  };;

(* consider the following record types: *)
type log_entry =
  { session_id: string;
    time: Time_ns.t;
    important: bool;
    message: string;
  }
type heartbeat =
  { session_id: string;
    time: Time_ns.t;
    status_message: string;
  }
type logon =
  { session_id: string;
    time: Time_ns.t;
    user: string;
    credentials: string;
  }

(* B1: for common field names, typechecker picks the most recent definition*)
let get_session_id t = t.session_id;;
(* val get_session_id : logon -> string = <fun>  <=== this is from logon (most recent) *)

(* B2: the order of names that the typechecker has to do a lookup for affects whether it sees an ambiguity *)
let status_and_session t = (t.status_message, t.session_id);;
(* this resolves to heartbeat without ambiguity because it needs to resolve status_message and that field name is unique to heartbeat so our type is resolved without issue.

  val status_and_session : heartbeat -> string * string = <fun>
 *)
let session_and_status t = (t.session_id, t.status_message);;
(* this can't be resolved because it needs to resolve session_id and that field name is NOT unique to a particular record type.

Line 1, characters 45-59:
Error: This expression has type logon
       There is no field status_message within type logon
    *)

(* B3: type annotations remove ambiguity  *)
let session_and_status (t:heartbeat) = (t.session_id, t.status_message);;

(* Follows the "pack similar record types into modules" idiom *)
module Log_entry = struct
  type t =
    { session_id: string;
      time: Time_ns.t;
      important: bool;
      message: string;
    }
end
module Heartbeat = struct
  type t =
    { session_id: string;
      time: Time_ns.t;
      status_message: string;
    }
end
module Logon = struct
  type t =
    { session_id: string;
      time: Time_ns.t;
      user: string;
      credentials: string;
    }
end

(* creation function for Log_entry *)
let create_log_entry ~session_id ~important message =
  { Log_entry.time = Time_ns.now ();
    Log_entry.session_id;
    Log_entry.important;
    Log_entry.message
  };;

(* Reference 1: without the conciseness: *)
let create_log_entry ~session_id ~important message =
  { Log_entry.time = Time_ns.now ();
    Log_entry.session_id;
    Log_entry.important;
    Log_entry.message
  };;

(* Reference 2: adding a type annotation: *)
let create_log_entry ~session_id ~important message : Log_entry.t =
  { time = Time_ns.now (); session_id; important; message };;

(* Reference 3: annotation used for pattern matching *)
let message_to_string { Log_entry.important; message; _ } =
  if important then String.uppercase message else message;;

(* R4: annotation used for dot-access *)
let is_important t = t.Log_entry.important;;

(* R3: old *)
let message_to_string { Log_entry.important; message; _ } =
  if important then String.uppercase message else message;;
(* R3: new *)
let message_to_string ({ important; message; _ } : Log_entry.t) =
  if important then String.uppercase message else message;;

(* R4: old *)
let is_important t = t.Log_entry.important;;
(* R4: new *)
let is_important (t:Log_entry.t) = t.important;;

(* functional update*)
let register_heartbeat t hb =
  { t with last_heartbeat_time = hb.Heartbeat.time };;

(* original *)
let register_heartbeat t hb =
  { addr = t.addr;
    port = t.port;
    user = t.user;
    credentials = t.credentials;
    last_heartbeat_time = hb.Heartbeat.time;
};;

(* mutable record fields *)
type client_info =
  { addr: Core_unix.Inet_addr.t;
    port: int;
    user: string;
    credentials: string;
    mutable last_heartbeat_time: Time_ns.t;
    mutable last_heartbeat_status: string;
  }

(* mutation of the mutable fields when we register heartbeat. *)
let register_heartbeat t (hb:Heartbeat.t) =
  t.last_heartbeat_time   <- hb.time;
  t.last_heartbeat_status <- hb.status_message;;

#require "ppx_jane";;

module Logon = struct
  type t =
    { session_id: string;
      time: Time_ns.t;
      user: string;
      credentials: string;
    }
  [@@deriving fields]
end;;

(* this gives the following generated sub-module
    module Logon :
    sig
        type t = {
        session_id : string;
        time : Time_ns.t;
        user : string;
        credentials : string;
        }
        val credentials : t -> string
        val user : t -> string
        val time : t -> Time_ns.t
        val session_id : t -> string
        module Fields :
        sig
            val names : string list
            val credentials :
            ([< `Read | `Set_and_create ], t, string) Field.t_with_perm
            val user :
            ([< `Read | `Set_and_create ], t, string) Field.t_with_perm
            val time :
            ([< `Read | `Set_and_create ], t, Time_ns.t) Field.t_with_perm
    ...
        end
    end
*)

(* using this *)
let get_users logons =
  List.dedup_and_sort ~compare:String.compare
(List.map logons ~f:Logon.user);;

let show_field field to_string record =
  let name = Field.name field in
  let field_string = to_string (Field.get field record) in
  name ^ ": " ^ field_string;;

let logon =
 { Logon.
   session_id = "26685";
   time = Time_ns.of_string_with_utc_offset "2017-07-21 10:11:45Z";
   user = "yminsky";
   credentials = "Xy2d9W";
 };;

show_field Logon.Fields.user Fn.id logon;; (*NOTE: we use the =Fn= module here*)

(*********)
(* ====- *)
(*********)

let print_logon logon =
  let print to_string field =
    printf "%s\n" (show_field field to_string logon)
  in
  Logon.Fields.iter
    ~session_id:(print Fn.id)
    ~time:(print Time_ns.to_string)
    ~user:(print Fn.id)
    ~credentials:(print Fn.id);;

print_logon logon;;