(define-module (language python module string)
  #:use-module (oop pf-objects)
  #:use-module (oop goops)
  #:use-module (ice-9 match)
  #:use-module (language python number)
  #:use-module (language python exceptions)
  #:use-module (language python yield)
  #:use-module (language python list)
  #:use-module (language python for)
  #:use-module (language python def)
  #:use-module (language python string)
  #:use-module (parser stis-parser)
  #:export (Formatter))

(define (repr x) ((@ (guile) format) #f "~a" x))
(define int (mk-token (f+ (f-reg! "[0-9]")) string->number))
(define id  (mk-token (f-seq (f-reg! "[_a-zA-Z]")
                             (f* (f-reg! "[_0-9a-zA-Z]")))))
(define str (mk-token (f+ (f-not! (f-char #\[)))))

(define conversion (mk-token (f-reg "[rsa]")))

(define fill      (mk-token (f-reg! ".")))
(define align     (mk-token (f-reg! "[<>=^]")))
(define sign      (mk-token (f-reg! "[-+ ]")))
(define width     int)
(define precision int)
(define type      (mk-token (f-reg! "[bcdeEfFgGnosxX%]")))
(define formatSpec
  (f-list
   (gg? (f-list #:align (gg? fill) align))
   (gg? sign)
   (gg? (mk-token (f-tag! "#")))
   (gg? (mk-token (f-tag! "0")))
   (gg? width)
   (gg? (mk-token (f-tag ",")))
   (gg? (f-seq "." precision))
   (gg? type)))

(define (get-align s align width sign)
  (define widthq (- width (len sign)))
  (define (f s a l)
    (match a
      ("<" (apply py-ljust  (+ sign s) width l))
      (">" (apply py-rjust  (+ sign s) width l))
      ("^" (apply py-center (+ sign s) width l))
      ("=" (+ sign (apply py-rjust s widthq l)))))
     
  (match align
    (#f
     (f s "<" '()))
    ((_ #f a)
     (f s a '()))
    ((_ fill a)
     (f s a (list fill)))))

(define (convert-string format-str s)
  (match (with-fluids ((*whitespace* f-true))
           (stis-parse format-str (f-seq formatSpec f-eof)))
    ((align sign sharp zero width comma rec type)
     (if width
         (get-align s align width "")
         s))
    (_ (raise (ValueError (+ "wrong format " format-str))))))

(set! (@@ (language python string) format)
      (lambda (f s)
	(py-format s f)))

(define (gen-sign s sign)
  (let lp ((sign sign))
    (match sign
      (#f  (lp "-"))
      ("+" (if (< s 0)
               (values (- s) "-")
               (values s     "+")))
      ("-" (if (< s 0)
               (values (- s) "-")
               (values s     "")))
      (" " (if (< s 0)
               (values (- s) "-")
               (values s     " "))))))

(define (convert-float s format-str)
  (match (with-fluids ((*whitespace* f-true))
           (stis-parse format-str (f-seq formatSpec f-eof)))
    ((align sign sharp zero width comma prec type)
     (call-with-values (lambda () (gen-sign s sign))                         
       (lambda (s s-sign)
         (let* ((prec (if prec prec 6))
                (s    (let lp ((type type))
                        (match type
                          (#f (lp "g"))
                          
                          ("f"
                           (format #f (+ "~," (number->string prec) "f") s))
                          
                          ("F"
                           (let ((s (format #f (+ "~," (number->string prec)
                                                  "f")
                                            s)))
                             (py-replace
                              (py-replace s "nan" "NAN")
                              "inf" "INF")))

                          ("e"
                           (py-replace
                            (format #f (+ "~," (number->string prec) "e") s)
                            "E" "e"))

                          ("E"
                           (format #f (+ "~," (number->string prec) "e") s))
                          
                          ("g"
                           (let ((exp (log10 (abs s))))
                             (if (and (<= -4  exp)
                                      (<= exp (max 1 prec)))
                                 (lp "f")
                                 (lp "e"))))
                          ("G"
                           (let ((exp (log10 (abs s))))
                             (if (and (<= -4  exp)
                                      (<= exp (max 1 prec)))
                                 (lp "F")
                                 (lp "E"))))
                          ("n"
                           (let ((exp (log10 (abs s))))
                             (if (and (<= -4  exp)
                                      (<= exp (max 1 prec)))
                                 (lp "f")
                                 (format #f (+ "~," (number->string prec) "h")
                                         s))))

                          ("%"
                           (set s (* s 100))
                           (+ (lp "f") "%"))))))
                
           (if width
               (if zero
                   (get-align s '(#:align "0" "=") width
                              s-sign)
                   (get-align s align width
                              s-sign))
                          
               (+ s-sign s))))))))

(define (convert-complex s format-str)
  (match (with-fluids ((*whitespace* f-true))
           (stis-parse format-str (f-seq formatSpec f-eof)))
    ((align sign sharp zero width comma prec type)
     (let* ((prec (if prec prec 6))
            (s    (let lp ((type type))
                    (match type
                      (#f (lp "f"))
                      ("f"
                       (format #f (+ "~," (number->string prec) "i") s))))))
       (if width
           (get-align s align width "")
           s)))))
                
                        
(define-method (py-format (s <real>) f)
  (convert-float s f))
(define-method (py-format (s <py-float>) f)
  (convert-float s f))

(define-method (py-format (s <complex>) f)
  (convert-complex s f))
(define-method (py-format (s <py-complex>) f)
  (convert-complex s f))

                        
                         
                        
         
(define (convert-integer s format-str)
  (match (with-fluids ((*whitespace* f-true))
           (stis-parse format-str (f-seq formatSpec f-eof)))
    ((align sign sharp zero width comma prec type)
     (call-with-values (lambda () (gen-sign s sign))                         
       (lambda (s s-sign)
         (let ((prefix (if sharp
                           (match type
                             ("b" "0b")
                             ("x" "0x")
                             ("X" "0X")
                             ("o" "0o")
                             ("d"  "")
                             (#f  ""))
                           ""))
               (s (let lp ((type type))
                    (match type
                      ("b"
                       (if comma
                           (format #f "~:b"       s)
                           (format #f "~b"        s)))
                      ("x"
                       (if comma
                           (format #f "~:x"      s)
                           (format #f "~x"       s)))
                      ("X"
                       (if comma
                           (format #f "~:@(~:x~)" s)
                           (format #f "~:@(~x~)"  s)))
                      ("o"
                       (if comma
                           (format #f "~:o"      s)
                           (format #f "~o"       s)))
                      ("d"
                       (if comma
                           (format #f "~:d" s)
                           (format #f "~d" s)))
                      (#f
                       (lp "d"))))))
           (if width
               (if zero
                   (get-align s '(#:align "0" "=") width
                              (+ s-sign prefix))
                   (get-align (+ prefix s) align width
                              s-sign))
               
               (+ s-sign prefix s))))))))

(define-method (py-format (s <integer>) f)
  (convert-integer s f))

(define-method (py-format (o <py-int>) f)
  (convert-integer (slot-ref o 'x) f))

(define argName (f-or! id int))
(define attributeName id)
(define elementIndex  (f-or! int str))

(define fieldName
  (f-cons argName (ff* (f-or! (f-list #:attr "." attributeName)
                              (f-list #:elem "[" elementIndex "]")))))

(define replField
  (f-list
   #:field
   (ff?            (mk-token (f-scope fieldName ))  None)
   (ff? (f-seq "!" (mk-token (f-scope conversion))) None)
   (ff? (f-seq ":" (mk-token (f-scope formatSpec))) None)))
 
(define tag     (f-seq (f-tag "{") replField (f-tag "}")))
(define nontag  (f-list #:str
                        (mk-token (f+ (f-or! (f-tag! "{{") (f-not! tag))))))
(define e       (f-seq (ff* (f-or! tag nontag)) f-eof))

(define mk-gen
  (make-generator (l)
    (lambda (yield l)
      (let lp ((u l) (i 0))
        (match u
          (()
           (yield "" None None None))
          (((#:str str))
           (yield str None None None))
          (((#:field a b c))
           (if (eq? a None)
               (yield "" (number->string i) c b)
               (yield "" a b c)))
          (((#:field a b c) . u)
           (if (eq? a None)
               (begin
                 (yield "" (number->string i) c b)
                 (lp u (+ i 1)))
               (begin
                 (yield "" a b c)
                 (lp u i))))
          (((#:str s) (#:field a b c) . u)
           (if (eq? a None)
               (begin
                 (yield s (number->string i) c b)
                 (lp u (+ i 1)))
               (begin
                 (yield s a c b)
                 (lp u i)))))))))
     
(define (f-parse str)
  (let ((l (with-fluids ((*whitespace* f-true))
             (parse str e))))
    (mk-gen l)))        

(define stis-parse parse)

(define-python-class Formatter ()
  (define format
    (lam (self format_string (* args) (** kwargs))
         ((ref self 'vformat) format_string args kwargs)))

  (define vformat
    (lambda (self format_string args kwargs)
      (set self '_args '())
      (for ((s fn fo co : ((ref self 'parse) format_string))) ((ss '("")))
           (if (eq? fn None)
               (cons s ss)
               (let* ((fn2 ((ref self 'get_field    ) fn args kwargs))
                      (fn3 (if (and (eq? fo None) (eq? co None))
                               ((ref self 'convert_field)  fn2 "r")
                               (let ((fn3 (if (eq? co None)
                                              fn2
                                              ((ref self 'convert_field)
                                               fn2 co))))
                                 (if (eq? fo None)
                                     fn3
                                     ((ref self 'format_field )
                                      fn3 fo))))))
                 (cons* fn3 s ss)))
           #:final
           (begin
             ((ref self 'check_unused_args) (ref self '_args) args kwargs)
             (apply string-append (reverse ss))))))

  (define parse
    (lambda (self format_string)
      (f-parse format_string)))
  
  (define get_field
    (lambda (self field_name args kwargs)
      (match (with-fluids ((*whitespace* f-true))
               (stis-parse field_name fieldName))
        ((key a ...)
         (set self '_args (cons key (ref self '_args)))
         (let ((f ((ref self 'get_value) key args kwargs)))
           (let lp ((a a) (f f))
             (match a
               (((#:ref r) . l)
                (lp l (ref f (string->symbol r))))
               (((#:elem k) . l)
                (lp l (pylist-ref f k)))
               (()
                f)))))
        (_
         (throw TypeError "wromg field name format")))))

  (define get_value
    (lambda (self key args kwargs)
      (set self '__args (cons key args))
      (if (integer? key)
          (pylist-ref args   key)
          (pylist-ref kwargs key))))
  
  (define check_unused_args
    (lambda (self used_args args kwargs)
      (let ((n (len args)))
        (let lp ((i 0))
          (if (< i n)
              (if (member i used_args)
                  (lp (+ i 1))
                  (warn "unused arg" i)))))
      (for ((k v : kwargs)) ()
           (if (not (member k used_args))
               (warn "unused arg" k)))))
            

  (define format_field
    (lambda (self value format_spec)
      (py-format value format_spec)))
  
  (define convert_field
    (lambda (self value conversion)
      (cond
       ((equal? conversion "s")
        (str value))
       ((equal? conversion "r")
        (repr value))
       ((equal? conversion "a")
        (ascii value))
       (else
        (throw TypeError "conversion" conversion))))))

(define (ascii x) (bytes x))

(set! (@@ (language python string) formatter) (Formatter))