(define-module (simulation)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-9)
  #:use-module (srfi srfi-11)
  #:use-module (srfi srfi-69)
  #:use-module (ice-9 atomic)
  #:use-module (ice-9 match)
  #:use-module (ice-9 getopt-long)
  #:use-module (fibers)
  #:use-module (fibers channels)
  #:use-module (fibers operations)
  #:use-module (fibers timers))

(define RX1 1) ; s (has to be between 1-15s)
(define RX2 (+ 2 RX1)) ; s
(define RECEIVE_DELAY1 3) ; s
(define RECEIVE_DELAY2 (+ 2 RECEIVE_DELAY1)) ; s
(define RETRANSMISSION_DELAY 2) ; s
;; From RP002 (Regional Parameters):
;; MAC commands exist in the LoRaWAN® specification to change the value of
;; RECEIVE_DELAY1 (using RXTimingSetupReq, RXTimingSetupAns) as well as
;; ADR_ACK_LIMIT and ADR_ACK_DELAY (using ADRParamSetupReq, ADRParamSetupAns).
;; Also, RXTimingSettings are transmitted to the end device along with the
;; JOIN_ACCEPT message in OTAA mode.

;; TODO: put a time limit as a parameter
(define-syntax-rule (forever exp ...)
  (let loop ()
    (begin exp ...)
    (loop)))

;; Synchronized logger
(define *output-channel* (make-channel))
(define (logger)
  (forever
    (let ((msg (get-message *output-channel*)))
      (display msg))))

(define (time->milliseconds time)
  (let* ((seconds (car time))
         (micros  (cdr time)))
    (+ (* 1000 seconds) (round (/ micros 1000)))))
(define %start-time (time->milliseconds (gettimeofday)))
(define (ll f . data)
  (spawn-fiber
    (lambda ()
      (put-message
        *output-channel*
        (format #f "~12'0d - ~?~%" (- (time->milliseconds (gettimeofday))
                                      %start-time) f data)))))

;; Synchronized id generator
(define *id-channel-in* (make-channel))
(define *id-channel-out* (make-channel))
(define (counter)
   (let loop ((id 0))
     (let ((msg (get-message *id-channel-in*)))
       (put-message *id-channel-out* id)
       (loop (1+ id)))))

(define (new-id)
  (put-message *id-channel-in* #t)
  (get-message *id-channel-out*))


;; For timer operations
(define (seconds->time-unit s)
  (* internal-time-units-per-second s))

;; For End-Device <--> Radio <--> Gateway
;; type can be:
;; '[up/down]link-start
;; '[up/down]link-end
;; 'interference
(define-record-type <radio-event>
  (make-radio-event type id channel-n frame)
  radio-event?
  (type radio-event-type)
  (id radio-event-id)  ;; Match the start-interference-end events
  (channel-n radio-event-channel-n)
  (frame radio-event-frame))

;; For Gateway <--> Network Server
(define-record-type <network-event>
  (make-network-event gateway-id frame)
  network-event?
  (gateway-id network-event-gateway-id)
  (frame network-event-frame))

;; body can be:
;; 'unconfirmed-data (uplink)
;; 'confirmed-data (uplink)
;; 'ack (downlink)
(define-record-type <frame>
  (make-frame FCnt DeviceAddr mac-commands body)
  frame?

  (FCnt frame-FCnt)
  (DeviceAddr frame-DeviceAddr)

  (mac-commands frame-mac-commands)
  (body frame-body))


(define-record-type <device>
  (make-device channel thunk)
  device?
  (channel device-channel)
  (thunk device-thunk))

(define (rand-time)
  (random 2.))

(define (make-class-a id initial-channel upstream-chn downstream-chn)
  (define window (make-channel))
  ;; Activates/deactivates the message sink to avoid blocking on messages we
  ;; don't need
  (define internal-com (make-channel))
  ;; Make all atomic
  (define channel initial-channel)

  ;; TODO: Unhardcode me
  (define time-on-air 0.01)
  (define to-confirm (make-atomic-box #f))
  (define NbTrans 3)
  (define Cu 0)
  (define Cd 0)

  (define retransmissions NbTrans) ;; decrement in each transmission

  (define (process-downlink! frame)
    ;; TODO
    (ll "Device ~a got downlink frame ~a" id frame))

  #;(define (confirm frame-FCnt)
    (when  (eq? frame-FCnt (atomic-box-compare-and-swap! to-confirm frame-FCnt #f))
      (spawn-fiber
        (lambda () "confirm confirmation frame"))))

  (define (send-uplink-frame frame-number device-addr confirmed?)
    (let* ((event-id id)
           (frame (make-frame
                    frame-number
                    id
                    '()
                    (if confirmed? 'confirmed-data 'unconfirmed-data))))
      (when confirmed?
        (atomic-box-compare-and-swap! to-confirm #f frame-number))
      (put-message upstream-chn (make-radio-event 'uplink-start event-id channel frame))
      (sleep time-on-air)
      (put-message upstream-chn (make-radio-event 'uplink-end event-id channel frame))))


  (define (receive-window channel time)
    (define (listening-to? chn)
      (= channel chn))

    (define (detect-preamble)
      (let wait-for-downlink-start ()
        (let ((msg (perform-operation
                     (choice-operation
                       (wrap-operation (sleep-operation time)
                                       (lambda _ 'time-is-out))
                       (get-operation downstream-chn)))))
          (match msg
            ;; We got the preamble in time
            (($ <radio-event> 'downlink-start message-id (= listening-to? chn) frame)
             (ll "Device ~a got preamble" id)
             message-id)
            ;; No preamble in time
            ('time-is-out #f)
            ;; Current message is not a preamble, continue
            (_ (wait-for-downlink-start))))))

    (define (demodulate message-id)
      (let wait-for-downlink-end ((interference? #f))
        (let ((part-of-same-message? (lambda (i) (= message-id i)))
              (msg (get-message downstream-chn)))
          (match msg
            (($ <radio-event> 'interference
                (= part-of-same-message? id)
                (= listening-to? chn)
                frame)
             (wait-for-downlink-end #t)) ;; Got interference
            (($ <radio-event> 'downlink-end
                (= part-of-same-message? id)
                (= listening-to? chn)
                frame)
             (and (not interference?) frame))
            (_ (wait-for-downlink-end interference?))))))

    (put-message internal-com 'wait)
    (let* ((preamble-id (detect-preamble))
           (result      (and preamble-id (demodulate preamble-id))))
      (put-message internal-com 'continue)
      result))

  (define (device-operation)
    (define (wait-until t)
      (perform-operation
        (timer-operation t)))

    (define current-frame 0)
    (forever
      ;; TODO check to-confirm
      (ll "Device ~a waiting for data" id)
      (sleep (rand-time)) ;; wait for more data

      (send-uplink-frame current-frame id #t)
      (set! current-frame (1+ current-frame)) ;; TODO: improve
      (let* ((now       (get-internal-real-time))
             (RX1-start (+ now (seconds->time-unit RECEIVE_DELAY1)))
             (RX2-start (+ now (seconds->time-unit RECEIVE_DELAY2)))
             (downlink  (or (begin (wait-until RX1-start)
                                   (receive-window channel RX1))
                            (if (< (get-internal-real-time) RX2-start)
                              (begin (wait-until RX2-start)
                                     (receive-window channel RX2))
                              #f))))
        (when downlink (process-downlink! downlink)))))

  (define (downstream-sink)
    (forever
      (let ((ev (perform-operation
                  (choice-operation (get-operation internal-com)
                                    (get-operation downstream-chn)))))
        (match ev
          ('wait
           (ll "RX window started")
           (get-message internal-com)
           (ll "Sinking again"))
          (_ #f)))))

  (lambda ()
    (spawn-fiber device-operation)
    (spawn-fiber downstream-sink)))

(define (make-gateway id in radio network)
  (define time-on-air 0.01) ;s (TODO)
  (define pending-interferences '())

  (define (send-to-device frame)
    (ll "Trying to downlink")
    (spawn-fiber
      (lambda ()
        ;; TODO: choose channel properly
        (let ((event-id (new-id)))
          (ll "Gateway ~a sending downlink ~a" id frame)
          (put-message radio (make-radio-event 'downlink-start event-id 1 frame))
          (sleep time-on-air)
          (put-message radio (make-radio-event 'downlink-end   event-id 1 frame))))))

  (define (send-to-network-server x)
    (ll "Gateway ~a forwarding ~a" id x)
    (put-message network (make-network-event id x)))

  ;; Upstream: listen, and answer in new fibers
  (lambda ()
    (forever
      (let* ((ev (get-message in)))
        (match ev
          (($ <network-event> id frame)
           (send-to-device frame))
          (($ <radio-event> 'uplink-start event-id channel-n frame) #f)
          (($ <radio-event> 'interference event-id channel-n frame)
           (set! pending-interferences (cons ev pending-interferences)))
          (($ <radio-event> 'uplink-end event-id channel-n frame)
           (let-values (((mine not-mine)
                         (partition (lambda (x) (eq? (radio-event-id x)
                                                     (radio-event-id ev)))
                                    pending-interferences)))
             (set! pending-interferences not-mine)
             (when (null? mine) ;; TODO
               (send-to-network-server frame)))))))))


(define (make-radio in end-devices gateways)
  "Fiber for radio resource allocation/control."

  ;; We can access it only from one fiber! Careful!
  (define lorawan-channels (make-hash-table))
  (define (interferences ev chn)
    (let ((res (hash-table-ref/default lorawan-channels chn '())))
      (if (equal? res (list ev)) '() res)))
  (define (use-lorawan-channel! chn start-event)
    (hash-table-update!/default lorawan-channels chn
                        (lambda (event-list)
                          (cons start-event event-list))
                        '()))
  (define (release-lorawan-channel! chn end-event)
    (hash-table-update! lorawan-channels chn
      (lambda (event-list)
        (remove! (lambda (x) (eq? (radio-event-id x)
                                  (radio-event-id end-event)))
                 event-list))))
  (define (radio-event->interference ev)
    "Make a new radio-event of type 'interference from another radio-event"
    (match ev
      (($ <radio-event> type id channel-n frame)
       (make-radio-event 'interference id channel-n frame))))

  (lambda ()
    (forever
      (let ((ev (get-message in)))
        (match ev
          (($ <radio-event> 'uplink-start event-id channel-n frame)
           (ll "Device ~a started uplink-frame #~a on channel ~a"
               (frame-DeviceAddr frame)
               (frame-FCnt frame)
               channel-n)
           (use-lorawan-channel! channel-n ev)
           (let ((ints (interferences ev channel-n)))
             (hash-table-walk gateways
               (lambda (k gateway)
                 (spawn-fiber
                   (lambda ()
                     (put-message (device-channel gateway) ev)
                     (for-each
                       (lambda (ev)
                         (ll "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA")
                         (put-message (device-channel gateway)
                                      (radio-event->interference ev)))
                       ints)))))))

          (($ <radio-event> 'downlink-start event-id channel-n frame)
           (ll "Device ~a started downlink-frame #~a on channel ~a"
               (frame-DeviceAddr frame)
               (frame-FCnt frame)
               channel-n)
           (use-lorawan-channel! channel-n ev)
           (let ((chan (device-channel (hash-table-ref end-devices
                                                       (frame-DeviceAddr frame))))
                 (ints (interferences ev channel-n)))
             (put-message chan ev)
             (for-each
               (lambda (ev)
                 (ll "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA")
                 (put-message chan (radio-event->interference ev)))
               ints)))

          (($ <radio-event> 'uplink-end event-id channel-n frame)
           (ll "Device ~a ended uplink-frame #~a on channel ~a"
               (frame-DeviceAddr frame)
               (frame-FCnt frame)
               channel-n)
           (release-lorawan-channel! channel-n ev)
           (hash-table-walk gateways
             (lambda (k gateway)
               (spawn-fiber
                 (lambda ()
                   (put-message (device-channel gateway) ev))))))

          (($ <radio-event> 'downlink-end event-id channel-n frame)
           (ll "Device ~a ended downlink-frame #~a on channel ~a"
               (frame-DeviceAddr frame)
               (frame-FCnt frame)
               channel-n)
           (release-lorawan-channel! channel-n ev)
           (put-message
             (device-channel (hash-table-ref end-devices
                                             (frame-DeviceAddr frame)))
             ev)))))))


(define (make-network-server upstream gateways end-devices)

  (lambda ()
    (forever
      (match (get-message upstream)
        (($ <network-event> gateway-id frame)
         (ll "Network event happend!")
         ;; TODO answer properly
         (spawn-fiber
           (lambda ()
             (sleep RECEIVE_DELAY1)
             (put-message
               (device-channel (hash-table-ref gateways gateway-id))
               (make-network-event
                 gateway-id
                 (make-frame (frame-FCnt frame)
                             (frame-DeviceAddr frame)
                             #f
                             'hello))))))))))



(define (run-simulation end-device-count gateway-count)
  ;; We need synchronized logger and counter running in fibers
  (spawn-fiber logger)
  (spawn-fiber counter)

  (let* ((radio-chn   (make-channel))
         (end-devices (make-hash-table))
         (gateways    (make-hash-table))
         (network-chn (make-channel)))

    (for-each
      (lambda (id)
        (let ((chn (make-channel)))
          (hash-table-set!
            end-devices id
            (make-device chn (make-class-a id (modulo id 3) radio-chn chn)))))
      (iota end-device-count gateway-count))

    (for-each
      (lambda (id)
        (let ((chn (make-channel)))
          (hash-table-set!
            gateways id
            (make-device chn (make-gateway id chn radio-chn network-chn)))))
      (iota gateway-count 0))

    (spawn-fiber (make-network-server network-chn gateways end-devices))

    (spawn-fiber (make-radio radio-chn end-devices gateways))
    (hash-table-walk end-devices
                     (lambda (_ device) (spawn-fiber (device-thunk device))))
    (hash-table-walk gateways
                     (lambda (_ device) (spawn-fiber (device-thunk device))))))

(define (main args)
  (define help
"
LoRaWAN interference simulator:

USAGE:
~/guile simulation.scm -d END_DEVICE_COUNT -g GATWEWAY_COUNT

OPTIONS:
~/-g, --gateways~25tGateway count to add to the simulation
~/-d, --end-devices~25tEnd Device count to add to the simulation
~/-h, --help~25tShow this help~&
")
  (define option-spec
    '((gateways     (single-char #\g) (value #t))
      (end-devices  (single-char #\d) (value #t))
      (help         (single-char #\h) (value #f))))

  (let* ((options        (getopt-long args option-spec))
         (end-devices-op (option-ref options 'end-devices #f))
         (gateways-op    (option-ref options 'gateways #f)))
    (when (option-ref options 'help #f)
      (format #t help)
      (exit 0))
    (unless end-devices-op
      (format #t "ERROR: No end-device count provided~%")
      (exit 1))
    (unless gateways-op
      (format #t "ERROR: No gateway count provided~%")
      (exit 1))
    (let* ((end-devices (and end-devices-op (string->number end-devices-op)))
           (gateways    (and gateways-op (string->number gateways-op))))
      (unless (integer? end-devices)
        (format #t "ERROR: -d, --end-devices: expecting integer~%")
        (exit 1))
      (unless (integer? gateways)
        (format #t "ERROR: -g, --gateways: expecting integer~%")
        (exit 1))

      (run-fibers
        (lambda () (run-simulation end-devices gateways))
        #:drain? #t))))

(main (command-line))