#lang racket/base

; Phonagen generator - Racket implementation
; Dependencies
(require
  racket/string
  racket/list
  "../base-generation/random.rkt"
  "../base-generation/markov.rkt"
  "../base-generation/distribution.rkt"
  )

; Exported functions
(provide
  ; Generator
  jsexpr->phonagen
  phonagen-generate
  phonagen-generator-ids
  ; Word descriptions
  word-transcriptions
  word-pronounciation
  word-native-transcription
  word-latin-transcription
  )


; Phoneme structure
(struct phoneme
  (id ; Id of phoneme
   description ; Description
   transcriptions ; Transcriptions of phoneme
   ))

; Create a phoneme from a json description
(define (jsexpr->phoneme js)
  (phoneme
    (string->symbol (hash-ref js 'id))
    (hash-ref js 'description)
    ; Transcriptions: the js object minus 'id and 'description
    (hash-remove
      (hash-remove
        js
        'id)
      'description)
    ))

; Get a transcription of the phoneme from its id
(define (phoneme-transcription-get phon tr)
  (hash-ref (phoneme-transcriptions phon) tr))

; Phonology
(struct phonology
  (id ; Id of phonology
   description ; Description
   transcriptions ; Transcriptions
   main-transcription ; Main transcription
   phonemes ; Phonemes
   ))

; Create a phonology from a json description
(define (jsexpr->phonology js)
  (phonology
    (string->symbol (hash-ref js 'id))
    (hash-ref js 'description)
    (map string->symbol (hash-ref js 'transcriptions))
    (string->symbol (hash-ref js 'main-transcription))
    ; Phonemes
    (make-immutable-hash
      (map
        (lambda (x)
          (define phonm (jsexpr->phoneme x))
          (cons (phoneme-id phonm) phonm))
        (hash-ref js 'entries)))
    ))

; Get a phoneme from a phonology from its id
(define (phonology-get phon id)
  (hash-ref (phonology-phonemes phon) id))

; Generator (chain-based)
(struct chain-generator
  (id ; Id of generator
   description ; Description
   phonology ; Phonology used
   chains ; Markov Generator
   ))

; Create a chain-generator from a json description
(define (jsexpr->chain-generator js)
  (define chains (make-markov (hash-ref js 'order)))
  (define (->symbol x) (and (non-empty-string? x) (string->symbol x)))
  (for-each
    (lambda (chain)
      (define input (map ->symbol (hash-ref chain 'input)))
      (for-each
        (lambda (output)
          (markov-add-next-item!
            chains
            input
            (->symbol (hash-ref output 'value))
            (hash-ref output 'occurences)))
        (hash-ref chain 'possible-outputs)))
    (hash-ref js 'chains))
  (chain-generator
    (string->symbol (hash-ref js 'id))
    (hash-ref js 'description)
    (string->symbol (hash-ref js 'phonology))
    chains))

; Generate a list of phoneme id from a chain-generator
(define (chain-generator-generate gen)
  (markov-generate (chain-generator-chains gen)))

; Generator (rule-based)
(struct rule-generator
  (id ; Id of generator
   description ; Description
   phonology ; Phonology used
   rules ; Rules set
   ))

; Create a rule-generator from a json description
(define (jsexpr->rule-generator js)
  (rule-generator
    (string->symbol (hash-ref js 'id))
    (hash-ref js 'description)
    (string->symbol (hash-ref js 'phonology))
    ; Rules
    (make-immutable-hash
      (map
        (lambda (rule)
          (define dist (make-distribution))
          (for-each
            (lambda (x)
              (distribution-add-to!
                dist
                (map string->symbol (hash-ref x 'pattern))
                (hash-ref x 'occurences)))
            (hash-ref rule 'distribution))
          (cons (string->symbol (hash-ref rule 'id)) dist))
        (hash-ref js 'rules)))
    ))

; Generate a list of phoneme id from a rule-generator
(define (rule-generator-generate gen)
  (define (replace pattern-id)
    (if (hash-has-key? (rule-generator-rules gen) pattern-id)
        (map replace (distribution-generate (hash-ref (rule-generator-rules gen) pattern-id)))
        pattern-id))
  (flatten (replace 'word)))

; Make a generator, according to the corresponding type
(define (jsexpr->generator js)
  (case (hash-ref js 'type)
    (("rules") (jsexpr->rule-generator js))
    (("chains") (jsexpr->chain-generator js))
    (else (error "Unsupported generator: " (hash-ref js 'type)))))

; Get the generator id from a generator
(define (generator-id gen)
  (cond
    ((rule-generator? gen) (rule-generator-id gen))
    ((chain-generator? gen) (chain-generator-id gen))
    (else (error "Not a generator: " gen))))

; Get the phonology from a generator
(define (generator-phonology gen)
  (cond
    ((rule-generator? gen) (rule-generator-phonology gen))
    ((chain-generator? gen) (chain-generator-phonology gen))
    (else (error "Not a generator: " gen))))

; Generate a list of phoneme id from a generator
(define (generator-generate gen)
  (cond
    ((rule-generator? gen) (rule-generator-generate gen))
    ((chain-generator? gen) (chain-generator-generate gen))
    (else (error "Not a generator: " gen))))

; Word structure
(struct word
  (phonemes ; List of phonemes of the words
   main-transcription ; Id of the main transcription
   transcriptions ; Map of transcriptions
   ))

; Generate a word from a generator and a phonology
(define (generate-word gen phon)
  ; List of phonemes of the word
  (define phonemes
    (map
      (lambda (x)
        (phonology-get phon x))
      (generator-generate gen)))
  ; Return the word
  (word
    phonemes
    (phonology-main-transcription phon)
    (make-immutable-hash
      (map
        (lambda (tr)
          (cons
            tr
            (string-join
              (map
                (lambda (x)
                  (phoneme-transcription-get x tr))
                phonemes)
              "")))
        (phonology-transcriptions phon)))
    ))

; Word->string function
(define (word->string wrd tr)
  (hash-ref (word-transcriptions wrd) tr))

; Get pronounciation string
(define (word-pronounciation wrd)
  (string-normalize-nfc (word->string wrd 'phoneme)))

; Get native transcription string
(define (word-native-transcription wrd)
  (word->string wrd (word-main-transcription wrd)))

; If there is a 'latin language, use it, else return the main transcription
(define (word-latin-transcription wrd)
  (if (hash-has-key? (word-transcriptions wrd) 'latin)
      (word->string wrd 'latin)
      (word-native-transcription wrd)))

; Phonagen generator
(struct phonagen
  (phonologies
   generators))

; Create a phonagen generator from a json expression
(define (jsexpr->phonagen js)
  (phonagen
    ; Phonologies
    (make-immutable-hash
      (map
        (lambda (x)
          (define phon (jsexpr->phonology x))
          (cons (phonology-id phon) phon))
        (hash-ref js 'phonologies)))
    ; Generators
    (make-immutable-hash
      (map
        (lambda (x)
          (define gen (jsexpr->generator x))
          (cons (generator-id gen) gen))
        (hash-ref js 'generators)))
    ))

; Generate a word from a phonagen file, with the generator optionally given
(define (phonagen-generate phgen [genid #f])
  (define gen (or (and genid (hash-ref (phonagen-generators phgen) genid))
                  (cdr (random:from-hash (phonagen-generators phgen)))))
  (generate-word
    gen
    (hash-ref (phonagen-phonologies phgen) (generator-phonology gen))))

; Get the list of generator ids
(define (phonagen-generator-ids phgen)
  (hash-keys (phonagen-generators phgen)))
