#lang scheme/base
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SHP: Hypertext Processor
;;
;; a PHP like web framework for PLT Scheme
;;
;; Bonzai Lab, LLC.  All rights reserved.
;;
;; Licensed under LGPL.
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; convert.ss - the base of the conversion API that glues between web request and scheme functions.
;; yc 7/6/2010 - first version
(require "depend.ss"
         (for-syntax scheme/base
                     (only-in "depend.ss" 
                              string-join
                              syntax-map
                              syntax-identifier-append 
                              arg->identifier 
                              args->identifiers 
                              )
                     )
         "query.ss"
         )
#|

The convert API handles the converion of values TO and FROM primitive values such as number, string, list, vector, etc. 

This API is designed to adapt against the xmlrpc & json libraries, so it can be easily used with APIs that require 
different primitive values. 

It is also designed for ensuring that we adapt either scalar (can be struct) or composite (definitely struct) so the conversion occur accordingly. 

Scalar types are basically types that can convert from primitive values, and composite types are types that need to be converted from multiple values. 

NOTE ***** THIS API IS NOT STABLE *** 

;;|#

;; the converter registry is not a pure cond-registry because we need to use it for pure comparison as well as using it as condition table.
(define converter-registry (make-assoc-registry)) 
;; basic set!, del!, and ref functions.
(define (converter-set! isa? converter)
  (registry-set! converter-registry isa? converter))
;; del!
(define (converter-del! isa?)
  (registry-del! converter-registry isa?)) 
;; ref
(define (converter-ref isa? (default #f)) 
  (registry-ref converter-registry isa? default)) 
;; the most basic type - return the actual result itself.
(converter-set! identity identity)

;; not-passed-in is used to determine whether or not a particular argument has value.  as this is not exposed outside of the module it cannot be
;; passed in by the client.
(define-struct not-passed-in ()) 

;; scalar-converter!
;; creates the converter for a scalar conversion.
(define-syntax scalar-converter!
  (syntax-rules () 
    ((~ (isa? convert) ...) 
     (lambda (v) 
       (cond ((isa? v) (convert v)) 
             ... 
             (else (error 'invalid "~s" v)))))
    ))

;; define-scalar-converter!
(define-syntax define-scalar-converter!
  (syntax-rules ()
    ((~ type? (isa? convert) ...)
     (converter-set! type? 
                     (scalar-converter! (type? identity) (isa? convert) ...)))
    ))

;; default scalar converters.
;; number
(define-scalar-converter! number?
  (string? string->number)) 
;; string
(define-scalar-converter! string?) 
;; bytes
(define-scalar-converter! bytes? 
  (string? string->bytes/utf-8)) 

;; listof converter helper

;; a listof converter
(define-struct list-of (isa? min max)) 

;; helper to create the listof converter.
(define (listof: isa? (min 0) (max +inf.0)) 
  (make-list-of isa? min max))

;; convert just one item.
(define (convert-one converter v) 
  (let ((res (converter v))) 
    (if (not res) 
        (error 'invalid-conversion "~s" v)
        res)))

;; convert-listof based on the inner convector, as well as min & max
(define (convert-listof converter v min max) 
  (define (helper lst) 
    (if (<= min (length lst) max)
        (map (lambda (v)
               (convert-one converter v)) 
             lst)
        (error 'convert-outside-range "[~a,~a]" min max)))
  (helper (cond ((list? v) v) 
                ((vector? v) (vector->list v)) 
                (else (list v)))))

;; run-convert tests to see whether the converter is a listof or not.
(define (run-convert isa? v)
  (if (list-of? isa?) 
      (let ((isa? (list-of-isa? isa?))
            (min (list-of-min isa?))
            (max (list-of-max isa?))) 
        (if-it (converter-ref isa?)
               (convert-listof it v min max)
               (error 'convert-unknown-type "~s" isa?)))
      (if-it (converter-ref isa?)
             (convert-one it v) 
             (error 'convert-unknown-type "~s" isa?))))

;; convert-spec
;;
;; a convert spec is use for converting part of a composite object
;; (there are 2 types - args converter & struct converter)
;; it holds the key (the name), the type (isa?), and whether there is a default value.
(define-struct convert-spec (key isa? default)
  #:property prop:procedure
  (lambda ($s v)
    (if (no-value? v)
        (if (not-passed-in? (convert-spec-default $s))
            (error 'required "~a" (convert-spec-key $s))
            (convert-spec-default $s))
        (run-convert (convert-spec-isa? $s) v))))

;; helper to crate the convert-spec
(define (build-convert-spec key 
                            (isa? identity) 
                            (default (make-not-passed-in)))
  (define (ensure-isa?-exists! isa?) 
    (if (list-of? isa?)
        (ensure-isa?-exists! (list-of-isa? isa?))
        (unless (converter-ref isa?)
          (error 'unknown-isa? "~s" isa?))))
  (ensure-isa?-exists! isa?)
  (make-convert-spec key isa? default))

;; syntax for creating the convert spec.
(define-syntax convert-spec! 
  (syntax-rules () 
    ((~ (key isa? default)) 
     (build-convert-spec 'key isa? default)) 
    ((~ (key isa?))
     (build-convert-spec 'key isa?)) 
    ((~ key) 
     (build-convert-spec 'key))
    ))

;; helper to convert with a list of convert-specs.
;; this is the helper to convert from a hash (which is generated from one of the api queries)
(define (convert-from-hash converters hash) 
  (map (lambda (converter)
         (converter (hash-ref hash (symbol->string (convert-spec-key converter)) #f)))
       converters)) 
;; (trace convert-from-hash)

;; use-webcall? is used to determine whether or not we are inside a webcall.
;; this is so that the webcall can be used as regular functions programmatically.
;; (the usage case is the include! within the shp scripts).
(define use-webcall? (make-parameter #f))

;; args-converter struct holds a list of the specs that can be used to convert values for a procdure.
(define-struct args-converter (specs)
  #:property prop:procedure 
  (lambda ($s v)
    (let ((specs (args-converter-specs $s)))
      (if (hash? v) 
          (convert-from-hash specs v)
          (map (lambda (spec v)
                 (spec v))
               specs
               v)))))

;; syntax to help with args-converter.
;; args-converter! should almost never be used directly since it is used within webcall.
(define-syntax args-converter! 
  (syntax-rules ()
    ((~ (spec ...))
     (make-args-converter (list (convert-spec! spec) ...)))
    ))

;; composite-converter
;; for converting a structure that requires composite values.
(define-struct composite-converter (maker specs)
  #:property prop:procedure 
  (lambda ($s v) 
    (if (hash? v) 
        (apply (composite-converter-maker $s) 
               (convert-from-hash (composite-converter-specs $s) v))
        (error 'invalid-argument "~s" v))))

;; the struct-convert-spec inherits from regular convert-spec as it also need a ref
;; so we can convert from the struct into a hash.
(define-struct (struct-convert-spec convert-spec) (ref))

;; syntax for generating a struct-convert-spec - should not be used directly.
(define-syntax struct-convert-spec! 
  (syntax-rules ()
    ((~ spec ref)
     (let ((s (convert-spec! spec)))
       (make-struct-convert-spec (convert-spec-key s)
                                 (convert-spec-isa? s)
                                 (convert-spec-default s)
                                 ref)))
    ))

;; struct-converter! 
;; (struct-converter! name (spec ...))
;; this is called struct converter because it follows what a struct looks like.
;; there could be composite converter that does not work the same way as a struct converter, but that might be
;; far and few in between.
(define-syntax (struct-converter! stx)
  (syntax-case stx () 
    ((~ name (spec ...)) 
     (with-syntax ((maker (syntax-identifier-append 'make- #'name))
                   (isa? (syntax-identifier-append #'name '?))
                   ((ref ...) (syntax-map (lambda (spec)
                                             (syntax-identifier-append 
                                              #'name 
                                              '- 
                                              (arg->identifier spec)))
                                           #'(spec ...))))
       #'(make-composite-converter maker
                                   (list (struct-convert-spec! spec ref) ...))))
    ))

;; define-struct-converter!
;; helper
(define-syntax (define-struct-converter! stx)
  (syntax-case stx () 
    ((~ name (spec ...)) 
     (with-syntax ((isa? (syntax-identifier-append #'name '?)))
       #'(converter-set! isa? 
                         (struct-converter! name (spec ...)))))
    ))

;; unconvert takes a value and go *backwards* to get back its primitive value.
(define (unconvert v (scalar-convert identity)) 
  ;; search against the converter to see if one of the types match the value.
  ;; this will require treating the converter-ref as a cond-ref!
  (define (helper converter)
    (if (and converter
             (composite-converter? (cdr converter)))
        ;; now we have convert-spec's ref.
        ;; we can then use it to redo the work...
        ;; grab the composite-convert's specs.
        (make-immutable-hash (map (lambda (spec) 
                          (cons (symbol->string (convert-spec-key spec))
                                (unconvert ((struct-convert-spec-ref spec) v) 
                                           scalar-convert)))
                        (composite-converter-specs (cdr converter))))
        (scalar-convert v)))
  ;; if it is a hash or a list we just want to work on the inner value...
  (cond ((list? v)
         (map (lambda (v) 
                (unconvert v scalar-convert)) v))
        ((hash? v) 
         (make-immutable-hash (hash-map v (lambda (k v) 
                                            (cons k (unconvert v scalar-convert))))))
        (else
         (helper (assf (lambda (test) (test v))
                       (registry-table converter-registry))))))

;; webcall - all webcall name could change!!!
;; this wraps around an args-converter and a procedure.
(define-struct webcall (args inner)
  #:property prop:procedure 
  (lambda ($s . args) ;; if it is web call we only take one argument...
    (if (use-webcall?) 
        (if (and (pair? args) 
                 (hash? (car args)))
            (apply (webcall-inner $s) ((webcall-args $s) (car args)))
            (apply (webcall-inner $s) ((webcall-args $s) args)))
        (apply (webcall-inner $s) args))))

;; syntax helper
(define-syntax (call! stx)
  (syntax-case stx () 
    ((~ (arg ...) exp ... exp2)
     (with-syntax (((key ...) (args->identifiers #'(arg ...))))
       #'(make-webcall (args-converter! (arg ...)) 
                       (lambda (key ...) exp ... exp2))))
    ))

;; syntax helper
(define-syntax define-call! 
  (syntax-rules () 
    ((~ (name arg ...) exp exp2 ...) 
     (define name (call! (arg ...) exp exp2 ...)))
    ))

(provide define-call!
         call!
         define-struct-converter! 
         define-scalar-converter! 
         )

(provide/contract 
 (struct webcall ((args procedure?) 
                  (inner procedure?)))
 (use-webcall? (parameter/c boolean?))
 (struct convert-spec ((key symbol?) 
                       (isa? procedure?) 
                       (default any/c)))
 (struct args-converter ((specs (listof convert-spec?))))
 (struct list-of ((isa? procedure?) 
                  (min exact-nonnegative-integer?) 
                  (max exact-nonnegative-integer?)))
 (converter-ref (->* (procedure?)
                     (any/c) 
                     any)) 
 (converter-set! (-> procedure? procedure? any))
 (unconvert (->* (any/c) 
                 (procedure?)
                 any))
 )