#lang racket/base

; Model and generation of locations like living places or birth places

; Dependencies
(require
  "../../collection/tree.rkt"
  "../../base-generation/random.rkt")

; Exported functions
(provide
  ; Location type
  location-type-name
  location-type-preposition-in
  location-type-preposition-near
  ; Locations
  place-name
  place-reference-link
  place-type
  ; Geography structure
  jsexpr->geography
  geography-get-place
  geography-random-subplace
  )

; Structure of type of location
(struct location-type
  (name
   preposition-in
   preposition-near))

; Structure of a location
(struct place
  (name
   reference-link
   type
   restricted?))

; Geography structure
(struct geography
  (location-types  ; table of location types
   place-tree)) ; tree of places

; Construction from JSON
; Location type
(define (jsexpr->location-type js)
  (location-type
    (hash-ref js 'name)
    (hash-ref js 'preposition-in)
    (hash-ref js 'preposition-near)))

; Location
(define (jsexpr->place js location-types (parent-reference-link #f))
  (place
    (hash-ref js 'name)
    (hash-ref js 'reference-link parent-reference-link)
    (hash-ref location-types (hash-ref js 'type))
    (hash-ref js 'restricted? #f)))

; Tree node
(define (jsexpr->place-node js location-types (parent-reference-link #f))
  (define value (jsexpr->place js location-types parent-reference-link))
  (tree
    (hash-ref js 'name)
    value
    (map
      (lambda (x)
        (jsexpr->place-node x location-types (place-reference-link value)))
      (hash-ref js 'locations (list)))))

; Geography
(define (jsexpr->geography js)
  ; Fill location types
  (define location-types (make-hash))
  (for-each
    (lambda (x)
      (define type (jsexpr->location-type x))
      (hash-set! location-types (location-type-name type) type))
    (hash-ref js 'location-types))
  ;
  (geography
    location-types
    (jsexpr->place-node (hash-ref js 'places) location-types)
    ))

; Find a place by its name
; Returns the path to the place or #f if it does not exists
(define (geography-find-place geo loc-name)
  (tree-find-path
    (geography-place-tree geo)
    (lambda (loc)
      (equal? loc-name (place-name loc)))))

; Get a place from its name or #f if it does not exists
(define (geography-get-place geo loc-name)
  (tree-ref
    (geography-place-tree geo)
    (geography-find-place geo loc-name)))

; Get a subplace of a place from its name
(define (geography-random-subplace geo loc-name)
  (define (next-place node)
    (define children
            (filter
              (lambda (x) (not (place-restricted? (tree-value x))))
              (tree-children node)))
    (if (null? children)
        (tree-value node)
        (next-place (random:from-list children))))
  (next-place
    (tree-node
      (geography-place-tree geo)
      (geography-find-place geo loc-name))))
