#lang typed/racket

(require "graph-6-rich-returns.lp2.rkt"
         "../lib/low.rkt"
         "graph.lp2.rkt"
         "get.lp2.rkt"
         "../type-expander/type-expander.lp2.rkt"
         "../type-expander/multi-id.lp2.rkt"
         "adt.lp2.rkt" ; debug
         "fold-queues.lp2.rkt"; debug
         "rewrite-type.lp2.rkt"; debug
         "meta-struct.rkt"; debug
         racket/splicing; debug
         (for-syntax syntax/parse)
         (for-syntax syntax/parse/experimental/template))

#|
(require "__DEBUG_graph6B.rkt")

(frozen (~>))
|#

(define-type blob String)
(define-type-expander (bubble stx) #'String)

(require (for-syntax syntax/strip-context))

(define-syntax (super-define-graph/rich-return stx)
  (syntax-case stx ()
    [(_ name . rest)
     (with-syntax ([(b (d (dgi n) . r) (dgi2 n2))
                    (replace-context
                     stx
                     #'(begin
                         (define-syntax-rule (dg1 name)
                           (define-graph/rich-return name ~> . rest))
                         (dg1 name)))])
       #'(b (d (dgX n) . r) (dgX n2)))]))

(super-define-graph/rich-return
   grr3
   ([City [streets : (~> m-streets)]]
    [Street [sname : String]])
   [(m-cities [cnames : (Listof (Listof bubble))])
    : (Listof City)
    (define (strings→city [s : (Listof blob)])
      (City (m-streets s)))
    (map strings→city cnames)]
   [(m-streets [snames : (Listof String)])
    : (Listof Street)
    (map Street snames)])

;(grr3 '(("a" "b") ("c")))

#;(super-define-graph/rich-return
   grr4
   ([City [streets : (~> m-streets)]]
    [Street [sname : String]])
   [(m-cities [cnames : (Listof (Listof bubble))])
    : (Listof City)
    (define (strings→city [s : (Listof blob)])
      (City (m-streets s)))
    (map strings→city cnames)]
   [(m-streets [snames : (Listof String)])
    : (Listof Street)
    (map Street snames)])

#|

(define-syntax-rule (dg grr)
  (define-graph/rich-return grr ~>
    ([City [streets : (~> m-streets)]]
     [Street [sname : String]])
    [(m-cities [cnames : (Listof (Listof bubble))])
     : (Listof City)
     (define (strings→city [s : (Listof blob)])
       (City (m-streets s)))
     (map strings→city cnames)]
    [(m-streets [snames : (Listof String)])
     : (Listof Street)
     (map Street snames)]))

(dg grr)
(dg grra)
|#










;; DEBUG:
(require (for-syntax racket/format
                     "rewrite-type.lp2.rkt"
                     racket/syntax
                     syntax/parse
                     (submod "../lib/low.rkt" untyped))
         (for-syntax syntax/parse
                     syntax/parse/experimental/template
                     racket/syntax
                     (submod "../lib/low.rkt" untyped)
                     "rewrite-type.lp2.rkt" #|debug|#
                     syntax/id-set
                     racket/format
                     mischief/transform)
         (rename-in "../lib/low.rkt" [~> threading:~>])
         "graph.lp2.rkt"
         "get.lp2.rkt"
         "../type-expander/type-expander.lp2.rkt"
         "../type-expander/multi-id.lp2.rkt"
         "adt.lp2.rkt" ; debug
         "fold-queues.lp2.rkt"; debug
         "rewrite-type.lp2.rkt"; debug
         "meta-struct.rkt"; debug
         racket/stxparam
         racket/splicing)




#;(define-graph
  grr31/first-step
  #:definitions
  ((define-type-expander
     (~> stx)
     (syntax-parse
         stx
       ((_ (~datum m-cities))
        (template
         (U
          (grr31/first-step
           #:placeholder
           m-cities4/node)
          (Listof
           (grr31/first-step
            #:placeholder
            City)))))
       ((_ (~datum m-streets))
        (template
         (U
          (grr31/first-step
           #:placeholder
           m-streets5/node)
          (Listof
           (grr31/first-step
            #:placeholder
            Street)))))))
   (define-type-expander
     (first-step-expander2 stx)
     (syntax-parse
         stx
       ((_ (~datum m-cities))
        #'(U
           m-cities4/node
           (Listof City)))
       ((_ (~datum m-streets))
        #'(U
           m-streets5/node
           (Listof Street))))))
  (City
   (streets
    :
    (Let
     (~> first-step-expander2)
     (~> m-streets)))
   ((City2/simple-mapping
     (streets
      :
      (~> m-streets)))
    (City streets)))
  (Street
   (sname
    :
    (Let
     (~> first-step-expander2)
     String))
   ((Street3/simple-mapping
     (sname : String))
    (Street sname)))
  (m-cities4/node
   (returned : (Listof City))
   ((m-cities
     (cnames
      :
      (Listof
       (Listof bubble))))
    (m-cities4/node
     (let ((City
            City2/simple-mapping)
           (Street
            Street3/simple-mapping))
       (define (strings→city
                (s
                 :
                 (Listof
                  blob)))
         (City (m-streets s)))
       (map
        strings→city
        cnames)))))
  (m-streets5/node
   (returned
    :
    (Listof Street))
   ((m-streets
     (snames
      :
      (Listof String)))
    (m-streets5/node
     (let ((City
            City2/simple-mapping)
           (Street
            Street3/simple-mapping))
       (map
        Street
        snames))))))


#;(define-graph
  grr3
  #:definitions
  ((define-type-expander
     (~>-to-result-type stx)
     (syntax-parse
         stx
       ((_ (~datum m-cities)) #'(Listof City))
       ((_ (~datum m-streets)) #'(Listof Street))))
   (define-type
     m-cities10/node-marker
     (Listof (grr3 #:placeholder City));
     #;(U (grr31/first-step m-cities4/node) (Listof (grr31/first-step City))))
   (define-type
     m-streets11/node-marker
     (Listof (grr3 #:placeholder Street));
     #;(U (grr31/first-step m-streets5/node) (Listof (grr31/first-step Street))))
   (define-type-expander
     (second-step-marker-expander stx)
     (syntax-parse
         stx
       ((_ (~datum m-cities)) #'m-cities10/node-marker)
       ((_ (~datum m-streets)) #'m-streets11/node-marker)))
   (define-type
     second-step-m-cities16/node-of-first
     (grr31/first-step m-cities4/node))
   (define-type
     second-step-m-streets17/node-of-first
     (grr31/first-step m-streets5/node))
   (define-type second-step-City18-of-first (grr31/first-step City))
   (define-type second-step-Street19-of-first (grr31/first-step Street))
   (define-type-expander
     (second-step-marker2-expander stx)
     (syntax-parse
         stx
       ((_ (~datum m-cities))
        #'(U
           second-step-m-cities16/node-of-first
           (Listof City #;(grr31/first-step City))))
       ((_ (~datum m-streets))
        #'(U
           second-step-m-streets17/node-of-first
           (Listof Street #;(grr31/first-step Street)))))) ;;;;;;;;;SHOULD BE A MARKER! (done here)
   (define-type-expander
     (inline-type* stx)
     (dbg
      ("inline-type*" stx)
      (syntax-parse
          stx
        ((_ i-tyy (~and seen (:id …)) (~optional msg))
         (when (attribute msg) (displayln (syntax-e #'msg)))
         (define/with-syntax replt #'i-tyy)
         #'(inline-type replt seen)))))
   (define-type-expander
     (inline-type stx)
     (dbg
      ("inline-type" stx)
      (syntax-parse
          stx
        ((_ i-t (~and seen (:id …)))
         (let ((seen-list (syntax->list #'seen)))
           (when (and
                  (not (null? seen-list))
                  (member (car seen-list) (cdr seen-list) free-identifier=?))
             (raise-syntax-error
              'define-graph/rich-returns
              (~a
               "Cycles in types are not allowed."
               " The following types were already inlined: "
               (syntax->datum #'seen)
               ", but "
               #'t
               " appeared a second time.")
              #'t)))
         (replace-in-type
          #'(Let ((~> second-step-marker-expander)) i-t)
          #'((second-step-m-cities16/node-of-first
              (inline-type* (Listof City) (m-cities4/node . seen)))
             (second-step-m-streets17/node-of-first
              (inline-type* (Listof Street) (m-streets5/node . seen)))
             (City (grr3 #:placeholder City))
             (Street (grr3 #:placeholder Street))))))))
   (define-syntax (inline-instance* stx)
     (dbg
      ("inline-instance*" stx)
      (syntax-parse
          stx
        ((_ i-ty seen)
         (define/with-syntax
           replt
           (replace-in-type
            #'(Let (~> second-step-marker2-expander) i-ty)
            #'((City second-step-City18-of-first)
               (Street second-step-Street19-of-first))))
         (displayln (list "replt=" #'replt))
         #'(inline-instance replt seen)))))
   (define-syntax (inline-instance stx)
     (dbg
      ("inline-instance" stx)
      (syntax-parse
          stx
        ((_ i-t (~and seen (:id …)))
         (define/with-syntax typp #'i-t)
         (define/with-syntax
           repl
           (replace-in-instance
            #'typp
            #'((second-step-m-cities16/node-of-first
                (inline-type* (Listof City) (m-cities4/node . seen) "RESSSS")
                (grr31/first-step #:? m-cities4/node)
                (λ ((x : second-step-m-cities16/node-of-first))
                  ((inline-instance* (Listof City) (m-cities4/node . seen))
                   (get x returned))))
               (second-step-m-streets17/node-of-first
                (inline-type* (Listof Street) (m-streets5/node . seen) "RESSSS")
                (grr31/first-step #:? m-streets5/node)
                (λ ((x : second-step-m-streets17/node-of-first))
                  ((inline-instance* (Listof Street) (m-streets5/node . seen))
                   (get x returned))))
               (second-step-City18-of-first
                (grr3 #:placeholder City)
                (grr31/first-step #:? City)
                City6/extract/mapping)
               (second-step-Street19-of-first
                (grr3 #:placeholder Street)
                (grr31/first-step #:? Street)
                Street7/extract/mapping))))
         (displayln (list "i-t=" #'typp))
         (let ((seen-list (syntax->list #'seen)))
           (when (and
                  (not (null? seen-list))
                  (member (car seen-list) (cdr seen-list) free-identifier=?))
             (raise-syntax-error
              'define-graph/rich-returns
              (~a
               "Cycles in types are not allowed."
               " The following types were already inlined: "
               (syntax->datum #'seen)
               ", but "
               #'t
               " appeared a second time.")
              #'t)))
         #'repl)))))
  (City
   (streets : (Let (~> ~>-to-result-type) (~> m-streets)))
   ((City6/extract/mapping (from : (grr31/first-step City)))
    (City ((inline-instance* (~> m-streets) ())
           #;(λ ((val : (U second-step-m-streets17/node-of-first (Listof (grr31/first-step Street)))))
             (first-value
              ((λ ((val : (U second-step-m-streets17/node-of-first (Listof (grr31/first-step Street)))) (acc : Void))
                 :
                 (values m-streets11/node-marker ;(U (inline-type* (Listof Street) (m-streets5/node) "RE1234")
                         ;                           (Listof (grr31/first-step Street)))
                         Void)
                 (cond
                   (((grr31/first-step #:? m-streets5/node) val)
                    ((ann
                      (λ ((x : second-step-m-streets17/node-of-first) (acc : Void))
                        (values ((λ ((x : second-step-m-streets17/node-of-first)) ((inline-instance* (Listof Street) (m-streets5/node)) (get x returned))) x) acc))
                      (→ second-step-m-streets17/node-of-first Void (values (inline-type* (Listof Street) (m-streets5/node) "RESSSS") Void)))
                     val
                     acc))
                   (#t
                    ((λ ((val : (Listof (grr31/first-step Street))) (acc : Void))
                       :
                       (values m-streets11/node-marker ;(Listof (grr31/first-step Street))
                               Void)
                       (let ((f
                              ((inst foldl (grr31/first-step Street) (Pairof (Listof (grr31/first-step Street)) Void) Nothing Nothing)
                               (λ ((x : (grr31/first-step Street))
                                   (acc1 : (Pairof m-streets11/node-marker;(Listof (grr31/first-step Street))
                                                   Void)))
                                 (let-values (((res res-acc) ((inst values (grr31/first-step Street) Void) x (cdr acc1))))
                                   (cons (cons res (car acc1)) res-acc)))
                               (cons '() acc)
                               val)))
                         (values (reverse (car f)) (cdr f))))
                     val
                     acc))
                   (else
                    (typecheck-fail
                     (U second-step-m-streets17/node-of-first (Listof (grr31/first-step Street)))
                     "Unhandled union case in (U second-step-m-streets17/node-of-first (Listof (grr31/first-step Street))), whole type was:(U second-step-m-streets17/node-of-first (Listof (grr31/first-step Street)))"))))
               val
               (void))))
           (get from streets)))
    ))
  (Street
   (sname : (Let (~> ~>-to-result-type) String))
   ((Street7/extract/mapping (from : (grr31/first-step Street)))
    (Street ((inline-instance* String ()) (get from sname))))))