#lang racket/base
(require racket/stream
         racket/list)

(define (stream-append* lst)
    (cond
      [(stream-empty? lst) lst]
      [else
       (define f1 (stream-first lst))
       (cond
         [(stream-empty? f1) (stream-append* (stream-rest lst))]
         [else (stream-cons (stream-first f1)
                            (stream-append* (stream-cons (stream-rest f1)
                                                         (stream-rest lst))))])]))

(define (make-it** lst #:in-order? [io? #f])
  (unless (andmap (λ (x) (and (integer? x) (< 0 x))) lst) (error "" lst))
  (define L (for/list ([i (in-list lst)][j (in-naturals)])j))

  (define (inner lst prev mx)
    (define f1 (filter (λ (x) (< 0 x)) lst))
    (cond
      [(empty? f1) empty-stream]
      [(empty? (cdr f1))
       (for/first ([l (in-list lst)]
                   [j (in-naturals)]
                   #:when (< 0 l))
         (when (= j prev) (error "" prev j))
         (stream (list (list (+ j 1) l))))]
      [else
       (stream-append*
        (for/stream ([l (in-list lst)]
                     [j (in-naturals)]
                     #:unless (= j prev)
                     #:when (< 0 l)
                     #:when (< j mx)
                     [i (in-range l)])
          (stream-map (λ (x) (cons (list (+ j 1) (+ i 1)) x))
                      (inner (list-update lst j (λ (x) (- l i 1)))
                             j
                             (+ 1 mx)))))]))

  (cond
    [(empty? lst) empty-stream]
    [(empty? (cdr lst)) (stream (list (list 1 (car lst))))]
    [else
     (stream-append*
            (for/stream ([i (in-range (car lst))])
              (stream-map (λ (x) (cons (list 1 (+ i 1)) x))
                          (inner (cons (- (car lst) i 1) (cdr lst))
                                 0
                                 (if io? 2 (+ 1 (length lst)))))))]))

(define (make-it lst #:in-order? [io #f])
  (stream->list (make-it** lst #:in-order? io)))
(define (sort-it lst)
  (sort lst
        (λ (x y)
          (define (inner x y)
            (cond
              [(empty? y) #t]
              [(empty? x) #f]
              [(equal? (car x) (car y)) (inner (cdr x) (cdr y))]
              [(< (caar x) (caar y)) #t]
              [(= (caar x) (caar y)) (>= (cadar x) (cadar y))]
              [else #f]))
          (inner x y))))

(module+ test
  (require rackunit)
  (check-equal? (sort-it (make-it '(1))) '(((1 1))))
  (check-equal? (sort-it (make-it '(2))) '(((1 2))))
  (check-equal? (sort-it (make-it '(1 1))) '(((1 1)(2 1))))
  (check-equal? (sort-it (make-it '(1 1 1) #:in-order? #t)) '(((1 1)(2 1)(3 1))))
  (check-equal? (sort-it (make-it '(2 2))) '(((1 2)(2 2))
                                             ((1 1)(2 2)(1 1))
                                             ((1 1)(2 1)(1 1)(2 1))))
  (check-equal? (sort-it (make-it '(2 2 1))) '(((1 2) (2 2) (3 1))
                                               ((1 2) (2 1) (3 1) (2 1))
                                               ((1 2) (3 1) (2 2))
                                               ((1 1) (2 2) (1 1) (3 1))
                                               ((1 1) (2 2) (3 1) (1 1))
                                               ((1 1) (2 1) (1 1) (2 1) (3 1))
                                               ((1 1) (2 1) (1 1) (3 1) (2 1))
                                               ((1 1) (2 1) (3 1) (1 1) (2 1))
                                               ((1 1) (2 1) (3 1) (2 1) (1 1))
                                               ((1 1) (3 1) (1 1) (2 2))
                                               ((1 1) (3 1) (2 2) (1 1))
                                               ((1 1) (3 1) (2 1) (1 1) (2 1))))