#lang racket/base

(require
  racket/string
  racket/list
  (prefix-in srfi13: srfi/13))

; Various functions for formatting words and sentences written in English.
(provide
  english:ordinal
  english:3rd-person-of
  english:undefined-article
  english:with-undefined-article
  english:plural-of
  english:add-commas
  )

; Get the ordinal of a given number
(define (english:ordinal N)
  (cond
    ((and (not (eq? 11 (modulo N 100))) (eq? 1 (modulo N 10))) (string-append (number->string N) "st"))
    ((and (not (eq? 12 (modulo N 100))) (eq? 2 (modulo N 10))) (string-append (number->string N) "nd"))
    ((and (not (eq? 13 (modulo N 100))) (eq? 3 (modulo N 10))) (string-append (number->string N) "rd"))
    (#t (string-append (number->string N) "th"))))

; Conjugate a verb at the 3rd person (present mode)
(define (english:3rd-person-of verb plural?)
  (cond
    ((equal? "be" verb) (if plural? "are" "is"))
    ((equal? "have" verb) (if plural? "have" "has"))
    (plural? verb)
    ; Only singular cases
    ((or (string-suffix? verb "s") (string-suffix? verb "sh") (string-suffix? verb "ch")
         (string-suffix? verb "x") (string-suffix? verb "o"))
     (string-append verb "es"))
    ((or (string-suffix? verb "ay") (string-suffix? verb "ey") (string-suffix? verb "iy")
         (string-suffix? verb "oy") (string-suffix? verb "uy"))
     (string-append verb "s"))
    ((string-suffix? verb "y")
     (string-append (srfi13:string-drop-right verb 1) "ies"))
    ;;
    (#t (string-append verb "s"))
  ))

; Get the undefined article that would prefix a given string
(define (english:undefined-article str)
  (define initial (string-downcase (substring str 0 1)))
  (if (string-contains? "aeiou" initial)
    "an"
    "a"))

; Return a string prefixed with the corresponding undefined article
(define (english:with-undefined-article str)
  (string-append (english:undefined-article str) " " str))

; Return the plural variant of a string
(define (english:plural-of str)
  (cond
    ((string-suffix? str "mouse")
     (string-append (srfi13:string-drop-right str 5) "mice"))
    ((string-suffix? str "louse")
     (string-append (srfi13:string-drop-right str 5) "lice"))
    ((string-suffix? str "goose")
     (string-append (srfi13:string-drop-right str 5) "geese"))
    ((string-suffix? str "foot")
     (string-append (srfi13:string-drop-right str 4) "feet"))
    ((string-suffix? str "tooth")
     (string-append (srfi13:string-drop-right str 5) "teeth"))
    ((string-suffix? str "man")
     (string-append (srfi13:string-drop-right str 3) "men"))
    ((or (string-suffix? str "s") (string-suffix? str "sh") (string-suffix? str "ch")
         (string-suffix? str "x") (string-suffix? str "o"))
     (string-append str "es"))
    ((or (string-suffix? str "ay") (string-suffix? str "ey") (string-suffix? str "iy")
         (string-suffix? str "oy") (string-suffix? str "uy"))
     (string-append str "s"))
    ((string-suffix? str "y")
     (string-append (srfi13:string-drop-right str 1) "ies"))
    ((string-suffix? str "ff")
     (string-append (srfi13:string-drop-right str 2) "ves"))
    ((string-suffix? str "f")
     (string-append (srfi13:string-drop-right str 1) "ves"))
    ((string-suffix? str "fe")
     (string-append (srfi13:string-drop-right str 2) "ves"))
    (#t
     (string-append str "s"))
  ))

; Add comma between elements of a list, with the last element introduced by "and"
(define (english:add-commas lst)
  (cond
    ; Nothing to add => return the list as is
    ( (>= 1 (length lst))
      lst)
    ; Add commas
    (#t
      (append
        (foldl
          (lambda (x result)
            (append result (list ", " x)))
          (list (car lst))
          (drop-right (cdr lst) 1))
        (list ", and " (last lst)))
    )))
