module Sig = Sig
module Repr = Repr

type kind =
  | None
  | Voyel
  | SemiVoyel

type code =
  | None
  | SZ (* This is a possible Z if followed by a voyel *)
  | Voyel_A
  | Voyel_E
  | E_Opened
  | E_Closed
  | Voyel_I
  | Voyel_O
  | Voyel_U (* OU like in Ouvrir *)
  | Voyel_Y (* U like in Unique *)
  | Voyel_AI
  | Voyel_EU
  | SemiVoyel_W
  | SemiVoyel_Y
  | Consonant_P
  | Consonant_B
  | Consonant_T
  | Consonant_D
  | Consonant_K
  | Consonant_G
  | Consonant_F
  | Consonant_V
  | Consonant_S
  | Consonant_Z
  | Consonant_X
  | Consonant_J

  | Consonant_M
  | Consonant_N
  | Consonant_L
  | Consonant_R
  | Diphtonge of t * t
  | Muted of t

and t =
  { code : code
  ; mutable_: bool (* Can the sound be muted ? *)
  ; kind : kind
  ; nasal : bool
  }

let is_voyel t =
  t.kind = Voyel
  || t.kind = SemiVoyel
let is_nasal t = t.nasal


let none =
  { mutable_ = true
  ; kind = None
  ; nasal = false
  ; code = None }

let voyel =
  { none with kind = Voyel }


let diphtongue v1 v2 =
  { voyel with
    code = Diphtonge (v1, v2)
  }

let a =
  { voyel with
    code = Voyel_A
  }

let voyel_ai =
  { voyel with
    code = Voyel_AI
  }

let e = function
  | `Closed -> { voyel with code = E_Closed }
  | `Opened -> { voyel with code = E_Opened }

let eu =
  { voyel with
    code = Voyel_EU
  }


let schwa () =
  { voyel with
    code = Voyel_E }

let o =
  { voyel with
    code = Voyel_O }

let i =
  { voyel with
    code = Voyel_I }

let voyel_y =
  { voyel with
    code = Voyel_Y }

let voyel_u =
  { voyel with
    code = Voyel_U }

let p =
  { none with
    code = Consonant_P
  ; mutable_ = false }

let b =
  { none with
    code = Consonant_B
  ; mutable_ = false
  }

let t =
  { none with
    code = Consonant_T
  }

let d =
  { none with
    code = Consonant_D }

let k =
  { none with
    code = Consonant_K
  ; mutable_ = false }

let g =
  { none with
    code = Consonant_G }

let f =
  { none with
    code = Consonant_F
  ; mutable_ = false
  }

let v =
  { none with
    code = Consonant_V }

let s =
  { none with
    code = Consonant_S }

let sz =
  { s with code = SZ }

let z =
  { none with
    code = Consonant_Z }

let ch =
  { none with
    code = Consonant_X
  ; mutable_ = false }

let j =
  { none with
    code = Consonant_J
  ; mutable_ = false }

let n =
  { none with
    code = Consonant_N
  ; nasal = true }

let m =
  { none with
    code = Consonant_M
  ; nasal = true }

let l =
  { none with
    code = Consonant_L }

let r =
  { none with
    code = Consonant_R }

let semi_voyel_w =
  { none with
    kind = SemiVoyel
  ; code = SemiVoyel_W}

let semi_voyel_y =
  { none with
    kind = SemiVoyel
  ; code = SemiVoyel_Y}

let nasal t =

  match t.code with
  | Voyel_E | E_Opened ->
    Some  { t with nasal = true }
  | Voyel_A -> Some  { t with nasal = true }
  | Voyel_AI -> Some { t with nasal = true }
  | Voyel_O -> Some  { t with nasal = true }
  | Voyel_I -> Some  { t with nasal = true }
  | Voyel_Y -> Some  { t with nasal = true }
  | Diphtonge (s1, s2) ->
    begin match s1.code, s2.code with
      | (SemiVoyel_W, Voyel_I) ->
        (* The only case we could have the nasalisation of such diphtongue, is
           the case O I, N -> wich is transformed into O, I N *)
        Some (
          diphtongue
            semi_voyel_w
            { i with nasal = true } )
      | (Voyel_I, Voyel_E) ->
        (* The only case we could have the nasalisation of such diphtongue, is
           the case I E, N -> wich is transformed into I, E N *)
        Some (
          diphtongue
            i
            { t with nasal = true } )
      | _ -> None
    end
  | _ -> None

let muted f =
  (* f is alway pronounend in endding consonant. Know exeception are :
     - cerf
     - clef
     - nerf
     - serf *)
  match f.mutable_ with
  | false -> f
  | true ->
    { none with
      code = Muted f }

let rec repr
  : type a. (module Sig.REPR with type t = a) -> t -> a
  = fun m letter ->
    let module Repr = (val m:Sig.REPR with type t = a) in
    match letter.code, letter.nasal with

    | None, _ -> Repr.none
    | Voyel_A, false -> Repr.a
    | Voyel_A, true  -> Repr.a_nasal
    | Voyel_AI, false -> Repr.e_opened
    | Voyel_AI, true  -> Repr.i_nasal
    | E_Closed, _ -> Repr.e_closed
    | E_Opened, true | Voyel_E, true -> Repr.a_nasal
    | Voyel_E , _ -> Repr.schwa
    | E_Opened, _ -> Repr.e_opened
    | Voyel_I, false -> Repr.i
    | Voyel_I, true -> Repr.i_nasal
    | Voyel_O, true -> Repr.o_nasal
    | Voyel_O, false -> Repr.o
    | Voyel_U, _  -> Repr.u
    | Voyel_Y, false -> Repr.y
    | Voyel_Y, true -> Repr.y_nasal
    | Voyel_EU, _ -> Repr.eu

    | SemiVoyel_W, _ -> Repr.semi_voyel_w
    | SemiVoyel_Y, _ -> Repr.semi_voyel_y

    | Consonant_P, _ -> Repr.p
    | Consonant_B, _ -> Repr.b
    | Consonant_T, _ -> Repr.t
    | Consonant_D, _ -> Repr.d
    | Consonant_K, _ -> Repr.k
    | Consonant_G, _ -> Repr.g
    | Consonant_F, _ -> Repr.f
    | Consonant_V, _ -> Repr.v
    | SZ, _
    | Consonant_S, _ -> Repr.s
    | Consonant_Z, _ -> Repr.z

    | Consonant_X, _ -> Repr.ch
    | Consonant_J, _ -> Repr.j

    | Consonant_M, _ -> Repr.m
    | Consonant_N, _ -> Repr.n
    | Consonant_L, _ -> Repr.l
    | Consonant_R, _ -> Repr.r
    | Diphtonge (l1, l2), _ -> Repr.diphtongue (repr m l1) (repr m l2)
    | Muted t, _ -> Repr.muted (repr m t)