(define-module (mudsync command)
  #:use-module (mudsync parser)
  #:use-module (mudsync gameobj)
  #:use-module (8sync systems actors)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-9)
  #:use-module (ice-9 control)
  #:use-module (ice-9 match)

  #:export (direct-command
            indir-command
            empty-command
            direct-greedy-command
            greedy-command
            player-gather-command-handlers
            find-command-winner))

;;; Commands
;;; ========

(define %low-priority 0)
(define %default-priority 1)
(define %high-priority 2)

(define-record-type <command>
  (make-command verbs matcher should-handle action priority)
  command?
  (verbs command-verbs)
  (matcher command-matcher)
  (should-handle command-should-handle)
  (action command-action)
  (priority command-priority))


(define (direct-command verbs action)
  (make-command verbs
                cmatch-direct-obj
                ;; @@: Should we allow fancier matching than this?
                ;;   Let the actor itself pass along this whole method?
                (lambda* (goes-by #:key direct-obj)
                  (member direct-obj goes-by))
                action
                %default-priority))

(define* (indir-command verbs action #:optional prepositions)
  (make-command verbs
                cmatch-indir-obj
                ;; @@: Should we allow fancier matching than this?
                ;;   Let the actor itself pass along this whole method?
                (lambda* (goes-by #:key direct-obj indir-obj preposition)
                  (if prepositions
                      (and
                       (member indir-obj goes-by)
                       (member preposition prepositions))
                      (member indir-obj goes-by)))
                action
                %high-priority))

(define (empty-command verbs action)
  (make-command verbs
                cmatch-empty
                (const #t)
                action
                %low-priority))

(define (greedy-command verbs action)
  (make-command verbs
                cmatch-greedy
                (const #t)
                action
                %low-priority))

(define (direct-greedy-command verbs action)
  "greedy commands but which match the direct object"
  (make-command verbs
                cmatch-direct-obj-greedy
                (lambda* (goes-by #:key direct-obj rest)
                  (member direct-obj goes-by))
                action
                %low-priority))

;; @@: We should probably ONLY allow these to go to users!
(define* (custom-command verbs matcher should-handle action
                         #:optional (priority %default-priority))
  "Full-grained customizable command."
  (make-command verbs matcher should-handle action priority))


;;; Command handling
;;; ================

;; @@: Hard to know whether this should be in player.scm or here...
;; @@: This could be more efficient as a stream...!?
(define (player-gather-command-handlers player verb)

  (define player-loc
    (let ((result (gameobj-loc player)))
      (if result
          result
          (throw 'player-has-no-location
                 "Player ~a has no location!  How'd that happen?\n"
                 #:player-id (actor-id player)))))

  ;; Ask the room for its commands
  (define room-commands
    ;; TODO: Map room id and sort
    (message-ref
     (<-wait player player-loc
             'get-container-commands
             #:verb verb)
     'commands))

  ;; All the co-occupants of the room (not including ourself)
  (define co-occupants
    (remove
     (lambda (x) (equal? x (actor-id player)))
     (message-ref
      (<-wait player player-loc 'get-occupants)
      'occupants)))

  ;; @@: There's a race condition here if someone leaves the room
  ;;   during this, heh...
  ;;   I'm not sure it can be solved, but "lag" on the race can be
  ;;   reduced maybe?

  ;; Get all the co-occupants' commands
  (define co-occupant-commands
    ;; TODO: Switch this to a fold.  Ignore a result if it
    ;;   returns false for in the command response
    (map
     (lambda (co-occupant)
       (let ((result (<-wait player co-occupant 'get-commands
                             #:verb verb)))
         (list
          (message-ref result 'commands)
          (message-ref result 'goes-by)
          co-occupant)))
     co-occupants))

  ;; Append our own command handlers
  (define our-commands
    ((@@ (mudsync player) player-self-commands) player))

  ;; TODO: Append our inventory's relevant command handlers

  ;; Now return a big ol sorted list of ((actor-id . command))
  (append
   (sort-commands-append-actor room-commands
                               player-loc '()) ; room doesn't go by anything
   (sort-commands-multi-actors co-occupant-commands)
   (sort-commands-append-actor our-commands
                               (actor-id player) '()))) ; nor does player

(define (sort-commands-append-actor commands actor-id goes-by)
  (sort-commands-multi-actors
   (map (lambda (command) (list command actor-id)) commands)))

(define (sort-commands-multi-actors actors-and-commands)
  (sort
   actors-and-commands
   (lambda (x y)
     (> (command-priority (cdr x))
        (command-priority (cdr y))))))


(define-record-type <command-winner>
  (make-command-winner action actor-id)
  command-winner?
  (action command-winner-action)
  (actor-id command-winner-action-id))


(define (find-command-winner sorted-candidates line)
  "Find a command winner from a sorted list of candidates"
  ;; A cache of results from matchers we've already seen
  (define matcher-cache '())
  (find
   (match-lambda
     ((command actor-id actor-goes-by)
      
      (let* ((matcher (command-matcher command))
             (matched (matcher line)))
        (if (and matched
                 ;; Great, it matched, but does it also pass
                 ;; should-handle?
                 (apply (command-should-handle command)
                        actor-goes-by
                        matched))  ; matched is kwargs if truthy
            actor-id
            #f))))
   sorted-candidates))