(*  User-Defined Datatypes *)

(* Record Types *)
type person = {name : string; ss : (int * int * int); age : int};;

(* Record Values *)
let teacher = {name = "Elsa L. Gunter"; age = 102; ss = (119,73,6244)};;
let student = {ss=(325,40,1276); name="Joseph Martins"; age=22};;
student = teacher;;

(* Record Pattern Matching*)
let {name = elsa; age = age; ss = (_,_,s3)} = teacher;;

(* Record Field Access *)
let soc_sec = teacher.ss;;

(* New Records from Old *)
let birthday person = {person with age = person.age + 1};;
birthday teacher;;
let new_id name soc_sec person = {person with name = name; ss = soc_sec};;
new_id "Guieseppe Martin" (523,04,6712) student;;

(* Enumeration Types as Variants User-defined *)

type weekday = Monday | Tuesday | Wednesday
  | Thursday | Friday | Saturday | Sunday;;

(* Functions Over Datatypes *)
let day_after day = match day with
      Monday -> Tuesday
  | Tuesday -> Wednesday
  | Wednesday -> Thursday
  | Thursday -> Friday
  | Friday -> Saturday
  | Saturday -> Sunday
  | Sunday -> Monday;;

(* Functions Over Datatypes *)
let rec days_later n day =
    match n with 0 -> day
    | _ -> if n > 0
          then day_after (days_later (n - 1) day)
         else days_later (n + 7) day;;
days_later 2 Tuesday;;
days_later (-1) Wednesday;;
days_later (-4) Monday;;

(* Disjoint Union Types *)
type id = DriversLicense of int | SocialSecurity of int | Name of string;;
let check_id id = match id with
      DriversLicense num -> 
       not (List.mem num [13570; 99999])
    | SocialSecurity num -> num < 900000000
    | Name str -> not (str = "John Doe");;

(* Polymorphism in Variants *)
type 'a option = Some of 'a | None;;

(* Functions over option *)
let rec first p list =
    match list with [ ] -> None
    | (x::xs) -> if p x then Some x else first p xs;;
first (fun x -> x > 3) [1;3;4;2;5];;
first (fun x -> x > 5) [1;3;4;2;5];;

(* Mapping over Variants *)
let optionMap f opt =
    match opt with None -> None
    | Some x -> Some (f x);;

optionMap
  (fun x -> x - 3)
  (first (fun x -> x > 3) [1;3;4;2;5]);;

(* Folding over Variants *)
let optionFold someFun noneVal opt =
    match opt with None -> noneVal
    | Some x -> someFun x;;

let optionMap f opt =
    optionFold (fun x -> Some (f x)) None opt;;

(* Recursive Data Types *)
type int_Bin_Tree = Leaf of int | Node of (int_Bin_Tree * int_Bin_Tree);;

(* Recursive Data Type Values *)
let bin_tree = Node(Node(Leaf 3, Leaf 6),Leaf (-7));;

(* Recursive Functions *)
let rec first_leaf_value tree =
    match tree with (Leaf n) -> n
    | Node (left_tree, right_tree) ->
     first_leaf_value left_tree;;

let left = first_leaf_value bin_tree;;

(* Mapping over Recursive Types *)
let rec ibtreeMap f tree =
    match tree with (Leaf n) -> Leaf (f n)
    | Node (left_tree, right_tree) ->
     Node (ibtreeMap f left_tree,
           ibtreeMap f right_tree);;

ibtreeMap ((+) 2) bin_tree;;

(* Folding over Recursive Types *)
let rec ibtreeFoldRight leafFun nodeFun tree =
    match tree with Leaf n -> leafFun n
    | Node (left_tree, right_tree) ->
      nodeFun
      (ibtreeFoldRight leafFun nodeFun left_tree)
      (ibtreeFoldRight leafFun nodeFun right_tree);;

let tree_sum = ibtreeFoldRight (fun x -> x) (+);;

tree_sum bin_tree;;

(* Mutually Recursive Types *)
type 'a tree = TreeLeaf of 'a
   | TreeNode of 'a treeList
and 'a treeList = Last of 'a tree
   | More of ('a tree * 'a treeList);;

(* Mutually Recursive Types - Values *)
let tree =
   TreeNode
    (More (TreeLeaf 5,
           (More (TreeNode
                  (More (TreeLeaf 3,
                         Last (TreeLeaf 2))),
                  Last (TreeLeaf 7)))));;

(* Mutually Recursive Functions *)
let rec fringe tree =
    match tree with (TreeLeaf x) -> [x]
  | (TreeNode list) -> list_fringe list
and list_fringe tree_list =
    match tree_list with (Last tree) -> fringe tree
  | (More (tree,list)) ->
    (fringe tree) @ (list_fringe list);;

fringe tree;;

(* Nested Recursive Types *)
type 'a labeled_tree = TreeNode of ('a * 'a labeled_tree list);;

(* Nested Recursive Type Values *)
let ltree =
  TreeNode(5,
    [TreeNode (3, []);
     TreeNode (2, [TreeNode (1, []);
                   TreeNode (7, [])]);
     TreeNode (5, [])]);;

(* Mutually Recursive Functions *)
let rec flatten_tree labtree =
    match labtree with TreeNode (x,treelist)
      -> x::flatten_tree_list treelist
    and flatten_tree_list treelist =
    match treelist with [] -> []
    | labtree::labtrees
      -> flatten_tree labtree
        @ flatten_tree_list labtrees;;

flatten_tree ltree;;

(* Infinite Recursive Values *)
let rec ones = 1::ones;;

match ones with x::_ -> x;;

let rec lab_tree = TreeNode(2, tree_list)
    and tree_list = [lab_tree; lab_tree];;

match lab_tree with TreeNode (x, _) -> x;;