#lang racket/base

; Model and generation of birth date
(require
  "../../base-generation/distribution.rkt")

; Only exported: calendar, date+sign
; Other structures are only used internally
(provide
  jsexpr->calendar calendar-generate-date calendar-get-date
  date+sign-day date+sign-month-name date+sign-month-number date+sign-sign-name date+sign-sign-symbol
  )

;;;;
; Month structure
(struct month
  (number
   name
   days
   named-after))

; Construction from json expressions
(define (jsexpr->month js)
  (month
    (hash-ref js 'number)
    (hash-ref js 'name)
    (hash-ref js 'days)
    (hash-ref js 'named-after)))

;;;;
; Simple date structure
(struct simple-date
  (month
   day))

; Simple date comparators
; Equal
(define (simple-date= d1 d2)
  (and
    (eq? (month-number (simple-date-month d1)) (month-number (simple-date-month d2)))
    (eq? (simple-date-day d1) (simple-date-day d2))))
; Inferior
(define (simple-date< d1 d2)
  (let ((m1 (month-number (simple-date-month d1)))
        (m2 (month-number (simple-date-month d2))))
    (or
      (< m1 m2)
      (and
        (eq? m1 m2)
        (< (simple-date-day d1) (simple-date-day d2))))))
; Superior
(define (simple-date> d1 d2)
  (let ((m1 (month-number (simple-date-month d1)))
        (m2 (month-number (simple-date-month d2))))
    (or
      (> m1 m2)
      (and
        (eq? m1 m2)
        (> (simple-date-day d1) (simple-date-day d2))))))
; Inferior or equal
(define (simple-date<= d1 d2)
  (not (simple-date> d1 d2)))
; Superior or equal
(define (simple-date>= d1 d2)
  (not (simple-date< d1 d2)))

; Construction from json expressions
(define (jsexpr->simple-date js months)
  (simple-date
    (hash-ref months (hash-ref js 'month))
    (hash-ref js 'day)))

;;;;
; Astrological sign structure
(struct astrological-sign
  (name
   symbol
   from
   to))

; Construction from json expressions
(define (jsexpr->astrological-sign js months)
  (astrological-sign
    (hash-ref js 'name)
    (hash-ref js 'symbol)
    (jsexpr->simple-date (hash-ref js 'from) months)
    (jsexpr->simple-date (hash-ref js 'to) months)))

;;;;
; Date and sign
(struct date+sign
  (month
   day
   sign))

; Accessors on date+sign
; Month name
(define (date+sign-month-name ds)
  (month-name (date+sign-month ds)))
; Month number
(define (date+sign-month-number ds)
  (month-number (date+sign-month ds)))
; Sign name
(define (date+sign-sign-name ds)
  (astrological-sign-name (date+sign-sign ds)))
; Sign symbol
(define (date+sign-sign-symbol ds)
  (astrological-sign-symbol (date+sign-sign ds)))

;;;;
; Calendar stucture
(struct calendar
  (months-map ; Map of month index to month
   months-distribution ; when picking a random date, a distribution is needed to take into account the fact that months may not have the same number of days
   astrological-signs))

; Calendar from json-expression
(define (jsexpr->calendar js)
  (define months-list (map jsexpr->month (hash-ref js 'months)))
  (define months-map (make-hash))
  (define months-distribution (make-distribution))
  (for-each
    (lambda (x)
      (hash-set! months-map (month-number x) x)
      (distribution-add-to! months-distribution x (month-days x)))
    months-list)
  (define sign-list (map (lambda (j) (jsexpr->astrological-sign j months-map)) (hash-ref js 'astrological-signs)))
  (calendar
    months-map
    months-distribution
    sign-list))

; Find the sign from a date
(define (calendar-get-sign cal date)
  (findf
    (lambda (as)
      (let ((accross-year? (simple-date< (astrological-sign-to as) (astrological-sign-from as))))
          (or (and (not accross-year?)
                    (simple-date<= (astrological-sign-from as) date)
                    (simple-date<= date (astrological-sign-to as)))
              (and accross-year?
                    (or (simple-date<= date (astrological-sign-from as))
                        (simple-date<= (astrological-sign-to as) date ))))))
      (calendar-astrological-signs cal)))

; Choose a random date from a calendar
; Returns a date+sign
(define (calendar-generate-date cal)
  (define m (distribution-generate (calendar-months-distribution cal))) ; Month
  (define d (+ 1 (random (month-days m)))) ; Day
  (date+sign
    m
    d
    (calendar-get-sign cal (simple-date m d))))

; Get a date from the month number and day number
; Returns a date+sign
(define (calendar-get-date cal m d)
  (let ((month (hash-ref (calendar-months-map cal) m)))
    (date+sign
      month
      d
      (calendar-get-sign cal (simple-date month d)))))
