#lang racket/base

; Model and generation of species

(require
  racket/list
  racket/set
  "../../base-generation/distribution.rkt")

(provide
  ; Field of species
  species?
  species-name species-compatibility-name species-reference-link species-endemic-in species-restricted-to-endemic-areas?
  species-affinity-distribution species-sex-distribution species-reproduction
  species-asexual-parent-species species-generable-as-character? species-citizen?
  species-pet? species-wild? species-vegetal? species-mimic? species-mimic-method species-mimic-genes-used?
  ; Functions on a species database structure
  jsexpr->species-database
  species-database-get
  species-database-all
  species-database-random
  species-database-find-crossbred-name
  species-database-all-possible-parents
  )

; Species structure
(struct species
  (name ; Name of species
   compatibility-name ; Name of the species to use when checking in the compatibility tables. A list of names for crossbreed species.
   reference-link ; link to reference
   endemic-in ; List of the names of areas the species is endemic
   restricted-to-endemic-areas? ; Indicate if the species only lives in endemic areas
   affinity-distribution ; Distribution of affinities
   sex-distribution ; Distribution of sexes
   reproduction ; type of reproduction, among: sexual, asexual, artifact
   asexual-parent-species ; List of the species names that can give birth to this species, in case of asexual reproduction
   generable-as-character? ; Indicate if the species can be choosen in generation of characters
   citizen? ; Indicate if the species is considered as citizen
   pet? ; Indicate if the species is considered as pet
   wild? ; Indicate if the species is considered as wild animal
   vegetal? ; Indicate if the species is vegetal
   mimic? ; Indicate if the species is a mimic species. An associated species must be generated to generate a character
   mimic-method ; Indicate how the associated species is choosen
   mimic-genes-used? ; If true, a character of a mimic species use the mimic species in its genes. If false, the character uses the imitated species genes
   ))

; Species database structure
(struct species-database
  (table
   crossbreed-table))

; Key to corresponding method - used for building mimic methods
(define keys->method
  (make-immutable-hash
    (list
      (cons 'name species-name)
      (cons 'reference-link species-reference-link)
      (cons 'endemic-in species-endemic-in)
      (cons 'restricted-to-endemic-areas? species-restricted-to-endemic-areas?)
      ; (cons 'affinity species-affinity-distribution)
      ; (cons 'sex species-sex-distribution)
      (cons 'reproduction species-reproduction)
      (cons 'asexual-parent-species species-asexual-parent-species)
      (cons 'generable-as-character? species-generable-as-character?)
      (cons 'citizen? species-citizen?)
      (cons 'pet? species-pet?)
      (cons 'wild? species-wild?)
      (cons 'vegetal? species-vegetal?)
      (cons 'mimic? species-mimic?)
      ; (cons 'mimic-method species-mimic-method)
      (cons 'mimic-genes-used? species-mimic-genes-used?))))

; Mimic method builder
; Returns a function that can be given to species-database-random as choosing predicate
(define (jsexpr->mimic-method js (base #f))
  (define mimic-method (hash-ref js 'species #f))
  (cond
    (mimic-method
      ; Create a species predicate from a species function and expected value
      (define (make-species-pred method value)
        (lambda (sp)
          (equal? (method sp) value)))
      ; Create a species predicate from a species function and a list of excluded values
      ; Used when a {"not": [...]} is used as value
      (define (make-species-excluding-pred method lst-values)
        (lambda (sp)
          (not (member (method sp) lst-values))))
      ; List of predicates to apply
      (define lst-pred
        (hash-map
          mimic-method
          (lambda (k v)
            (cond
              ; Special case for reproduction as the string values must be converted to symbols
              ( (and (eq? 'reproduction k)
                     (hash? v) (hash-has-key? v 'not))
                (make-species-excluding-pred (hash-ref keys->method k) (map string->symbol (hash-ref v 'not))))
              ( (eq? 'reproduction k)
                (make-species-pred (hash-ref keys->method k) (string->symbol v)))
              ; Other cases
              ( (and (hash? v) (hash-has-key? v 'not))
                (make-species-excluding-pred (hash-ref keys->method k) (hash-ref v 'not)))
              ( #t
                (make-species-pred (hash-ref keys->method k) v))))))
      ; Built predicate
      (lambda (sp)
        (andmap
          (lambda (fun)
            (fun sp))
          lst-pred))
      )
    (#t
      base)))

; Create a species from a json expression
(define (jsexpr->species js (base #f))
  (species
    (hash-ref js 'name (and base (species-name base)))
    (or (and base (species-compatibility-name base)) (hash-ref js 'name #f)) ; The compatibility name is the first species name encountered in the hierarchy of varieties
    (hash-ref js 'reference-link (and base (species-reference-link base)))
    (hash-ref js 'endemic-in (and base (species-endemic-in base)))
    (hash-ref js 'restricted-to-endemic-areas? (and base (species-restricted-to-endemic-areas? base)))
    (if (hash-has-key? js 'affinity)
        (jsexpr->distribution/object (hash-ref js 'affinity) #:translator symbol->string)
        (and base (species-affinity-distribution base)))
    (if (hash-has-key? js 'sex)
        (jsexpr->distribution/object (hash-ref js 'sex) #:translator symbol->string)
        (and base (species-sex-distribution base)))
    (if (hash-has-key? js 'reproduction)
        (string->symbol (hash-ref js 'reproduction))
        (and base (species-reproduction base)))
    (hash-ref js 'asexual-parent-species (and base (species-asexual-parent-species base)))
    (hash-ref js 'generable-as-character? (and base (species-generable-as-character? base)))
    (hash-ref js 'citizen? (and base (species-citizen? base)))
    (hash-ref js 'pet? (and base (species-pet? base)))
    (hash-ref js 'wild? (and base (species-wild? base)))
    (hash-ref js 'vegetal? (and base (species-vegetal? base)))
    (hash-ref js 'mimic? (and base (species-mimic? base)))
    (if (hash-has-key? js 'mimic-method)
        (jsexpr->mimic-method (hash-ref js 'mimic-method) (and base (species-mimic-method base)))
        (and base (species-mimic-method base)))
    (hash-ref js 'mimic-genes-used? (and base (species-mimic-genes-used? base)))
    ))

; Create a crossbreed species from a json expression and the species table
(define (jsexpr->crossbreed js species-table)
  (define (or-combine func a b)
    (or (func a) (func b)))
  (define (and-combine func a b)
    (and (func a) (func b)))
  (define parents (hash-ref js 'parents))
  (define parent-1 (hash-ref species-table (car parents)))
  (define parent-2 (hash-ref species-table (cadr parents)))
  (define child-js (hash-ref js 'child))
  (define child-species-name (hash-ref child-js 'name #f)) ; Note: if no name is given, name is set to false
  ; Returned value
  (define child
    (species
      child-species-name
      (list (species-compatibility-name parent-1) (species-compatibility-name parent-2)) ; Species compatibility is of both parents
      (hash-ref child-js 'reference-link (or-combine species-reference-link parent-1 parent-2))
      (hash-ref child-js 'endemic-in (append (species-endemic-in parent-1) (species-endemic-in parent-2)))
      (hash-ref child-js 'restricted-to-endemic-areas? (or-combine species-restricted-to-endemic-areas? parent-1 parent-2))
      (if (hash-has-key? child-js 'affinity)
        (jsexpr->distribution/object (hash-ref child-js 'affinity) #:translator symbol->string)
        (distribution-linear-combination
          (list
            (cons (species-affinity-distribution parent-1) 1)
            (cons (species-affinity-distribution parent-2) 1))))
      (if (hash-has-key? child-js 'sex)
        (jsexpr->distribution/object (hash-ref child-js 'sex) #:translator symbol->string)
        (distribution-linear-combination
          (list
            (cons (species-sex-distribution parent-1) 1)
            (cons (species-sex-distribution parent-2) 1))))
      'sexual ; Sexual reproduction is implied by the crossbreed
      (list) ; asexual-parent-species is only applicable to asexual reproduction
      (hash-ref child-js 'generable-as-character? (or-combine species-generable-as-character? parent-1 parent-2))
      (hash-ref child-js 'citizen? (or-combine species-citizen? parent-1 parent-2))
      (hash-ref child-js 'pet? (or-combine species-pet? parent-1 parent-2))
      (hash-ref child-js 'wild? (or-combine species-wild? parent-1 parent-2))
      (hash-ref child-js 'vegetal? (or-combine species-vegetal? parent-1 parent-2))
      (hash-ref child-js 'mimic? (or-combine species-mimic? parent-1 parent-2))
      (if (hash-has-key? js 'mimic-method)
          (jsexpr->mimic-method (hash-ref js 'mimic-method) (or-combine species-mimic-method parent-1 parent-2))
          (or-combine species-mimic-method parent-1 parent-2))
      (hash-ref child-js 'mimic-genes-used? (and-combine species-mimic-genes-used? parent-1 parent-2))
      ))
  ; Add the crossbreed species to the table of species if it has a name and that the name is not already present in the species list
  (when (and child-species-name (not (hash-has-key? species-table child-species-name)))
    (hash-set! species-table child-species-name child))
  ; Return the species
  child)

; Create a species database
(define (jsexpr->species-database js-species)
  ; Make the species table
  (define species-defaults (jsexpr->species (hash-ref js-species 'defaults)))
  (define species-table (make-hash))
  (define (process-species js base)
    (define sp (jsexpr->species js base))
    (hash-set! species-table (species-name sp) sp)
    (map
      (lambda (x) (process-species x sp))
      (hash-ref js 'varieties (list))))
  (map
    (lambda (x) (process-species x species-defaults))
    (hash-ref js-species 'species))
  ; Make the compatiblity table and crossbreed species if they have a name
  (define crossbreed-table
    (make-immutable-hash
      (map
        (lambda (x)
          (cons
            (list->set (hash-ref x 'parents))
            (jsexpr->crossbreed x species-table)))
        (hash-ref js-species 'crossbreeds))))
  ; Return
  (species-database
    species-table
    crossbreed-table))

; Get a species from its name
(define (species-database-get spdb name)
  (hash-ref (species-database-table spdb) name #f))

; Get all species satisfying a predicate
; Return an empty list if no species satisfy the predicate
(define (species-database-all spdb (pred (lambda (sp) #t)))
  (filter pred (hash-values (species-database-table spdb))))

; Get a random species satisfying a predicate
; Return #f if no species satisfy the predicate
(define (species-database-random spdb (pred (lambda (sp) #t)))
  (define lst (shuffle (species-database-all spdb pred)))
  (and (not (null? lst)) (car lst)))

; Get a crossbred name from a list of species names
; Return the input if no name is found
(define (species-database-find-crossbred-name spdb lst-names)
  (define crossbred
    (hash-ref
      (species-database-crossbreed-table spdb)
      (list->set lst-names)
      #f))
  (or
    (and crossbred (species-name crossbred))
    lst-names))

; Get all the possible parent species from a given species
; Based on the compatibility-name, return a list
(define (species-database-all-possible-parents spdb sp)
  ; Get the species
  (define compat-name (species-compatibility-name sp))
  ;
  (cond
    ; empty list if the species is unknown
    ((not sp) '())
    ; If a crossbread, combine the compatibilities from all base species
    ((list? compat-name)
     (apply
       append
       (map
         (lambda (x)
          (species-database-all-possible-parents spdb (species-database-get spdb x)))
         (species-compatibility-name sp))))
    ; Else => base species
    (#t
      ; All the species with the same compatibility name
      (define same-compat
        (species-database-all
          spdb
          (lambda (s) (equal? compat-name (species-compatibility-name s)))))
      ; All the crossbred containing the compatibility-name
      (define cross-compat
        (map
          cdr
          (filter
            (lambda (x) (set-member? (car x) compat-name))
            (hash->list (species-database-crossbreed-table spdb)))))
      ; Append the two lists
      (append same-compat cross-compat))))
