#|
Tax Form Language Design
Ross Foley
|#

(require test-engine/racket-gui)

;;;;;;;;;;;;;;;;;;;;;;;;; LANGUAGE - DATA DEFINITIONS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; a tax-form is (make-tax-form list[command])
(define-struct tax-form (commands))

#|
a command is either
 - output, or
 - display, or
 - request-input, or
 - multiple-choice, or
 - yes-no, or
 - request-list, or
 - conditional, or
 - compute-field, or
 - add-fields, or
 - tax-form, or
 - 'none
|#

;; a conditional is (make-conditional list[symbol] (values... -> boolean) command command))
#|
a conditional passes the values of the specified fields into the specified function.
If the function returns true, true-command is run, otherwise false-command is run.
|#
(define-struct conditional (fields run? true-command false-command))

;; an output is (make-output symbol string)
#|
an output is used to display the value of a field.
The value of the field will be inserted into the string
using the format function.
|#
(define-struct output (field string))

;; a display is (make-display string)
#|
a display outputs the specified text onto the screen.
|#
(define-struct display (text))

;; a request-input is (make-request-input string symbol)
#|
a request-input displays the text prompt, reads user input, and stores the result in the specified field
|#
(define-struct request-input (text field))

;; a multiple-choice is (make-multiple-choice string list[string] symbol)
#|
a multiple-choice displays the text prompt and choices, reads user input, and stores the result in the specified field
|#
(define-struct multiple-choice (text choices field))

;; a yes-no is (make-yes-no symbol)
#|
a yes-no displays the text prompt, reads user input, and stores the result in the specified field
("yes" will be stored as true and "no" will be stored as false)
|#
(define-struct yes-no (text field))

;; a request-list is (make-request-list string list[string] symbol)
#|
a request-list displays the list of prompts and records
the answers in a list.  The prompts are repeated until the
user specifies to stop.
|#
(define-struct request-list (name questions field))

;; a compute-field is (make-compute-field list[symbol] (values... -> value) symbol)
#|
a compute-field will pass the values of the needed-fields into the function
and store the result into the specified field.
|#
(define-struct compute-field (needed-fields func field))


;;;;;;;;;;;;;;;;;;;;;;;;; LANGUAGE - MACROS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; macro to wrap list around commands for tax-forms
(define-syntax tax-form
  (syntax-rules ()
    [(tax-form cmd1 ...)
     (make-tax-form (list cmd1 ...))]))

;; macro for outputing data to the screen (with or without field data)
(define-syntax output
  (syntax-rules ()
    [(output text)
     (make-display text)]
    [(output text field)
     (make-output 'field text)]))

;; macro for conditional statements (with or without false-command)
(define-syntax conditional
  (syntax-rules ()
    [(conditional field1 ... func true-cmd)
     (make-conditional (list 'field1 ...) func true-cmd 'none)]
    [(conditional field1 ... func true-cmd false-cmd)
     (make-conditional (list 'field1 ...) func true-cmd false-cmd)]))

;; macro for simplifying compute-field syntax
(define-syntax compute
  (syntax-rules (->)
    [(compute (field1 ...) -> func field)
     (make-compute-field (list 'field1 ...) func 'field)]))

;; macro for easy way to add fields without using compute
(define-syntax add
  (syntax-rules (->)
    [(add (field1 ...) -> result)
     (make-compute-field (list 'field1 ...) + 'result)]))

;; macro for simplifying multiple-choice syntax
(define-syntax multiple-choice
  (syntax-rules (:)
    [(multiple-choice text : (q1 ...) field)
     (make-multiple-choice text (list q1 ...) 'field)]))

;; macro for simplifying yes-no syntax
(define-syntax yes-no
  (syntax-rules ()
    [(yes-no text field)
     (make-yes-no text 'field)]))

;; macro for simplifying input requests (both for normal input and lists of input)
(define-syntax request
  (syntax-rules (:)
    [(request name : (q1 ...) field)
     (make-request-list name (list q1 ...) 'field)]
    [(request text field)
     (make-request-input text 'field)]))


;;;;;;;;;;;;;;;;;;;;;;;;; PROGRAM ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

#|
Schedule B Part I
|#
(define schedule-b-i
  (tax-form
   (request "payer" : ("Payer" "Amount") lineb1)
   (compute (lineb1) -> (lambda (b1)
                          (apply + (map (lambda (x) (list-ref x 1)) b1)))
            lineb4)
   (output "Total Taxable Interest: ~a" lineb4)))

#|
Schedule B Part II
|#
(define schedule-b-ii
  (tax-form
   (request "payer" : ("Payer" "Amount") lineb5)
   (compute (lineb5) -> (lambda (b5)
                          (apply + (map (lambda (x) (list-ref x 1)) b5)))
            lineb6)
   (output "Total Ordinary Dividends: ~a" lineb6)))

#|
Form 1040
|#
(define form1040
  (tax-form
   ;; Personal Information
   (request "First name" first-name)
   (request "Middle initial" middle-initial)
   (request "Last name" last-name)
   (request "Social security number" ssn)
   (request "Home address (number and street)" address)
   (yes-no "Do you want $3 going to the Presidential Election Campaign fund?" fund)

   ;; Filing Status
   (multiple-choice "Filing Status" : ("Single" "Head of household" "Qualifying widow(er)") filing-status)

   ;; Exemptions
   (yes-no "Are you an exemption?" line6a)
   (yes-no "Is your spouse an exemption?" line6b)
   (request "dependent" :
            ("First name" "Last name" "Dependent's social security number" "Dependent's relationship to you")
            line6c)
   (compute (line6a line6b line6c) -> (lambda (a b c)
                                        (let ([ex1 (if a 1 0)]
                                              [ex2 (if b 1 0)]
                                              [ex3 (length c)])
                                          (+ ex1 ex2 ex3)))
            line6d)

   ;; Income
   (request "Wages, salaries, tips, etc." line7)
   (request "Taxable interest" line8a)
   (conditional line8a (lambda (line8a) (> line8a 400)) schedule-b-i)
   (request "Ordinary dividends" line9a)
   (conditional line9a (lambda (line9a) (> line9a 400)) schedule-b-ii)
   (request "Qualified dividends" line9b)
   (request "IRA distributions" line15a)
   (request "Pensions and annuities" line16a)
   (request "Social security benefits" line20a)
   (request "Other income type" line21type)
   (request "Other income amount" line21amount)
   (add (line7 line8a line9a line9b line15a line16a line20a line21amount) -> line22)
   (output "Total Income: ~a" line22)))

#|
Schedule A
|#
(define schedule-a
  (tax-form
   ;; Medical and Dental Expenses
   (request "Medical and dental expenses" linea1)
   (compute (linea1 line38) -> (lambda (a1 line38)
                                 (if (> (* line38 0.075) a1)
                                     0
                                     (- a1 (* line38 0.075))))
            linea4)
   (output "Total Medical and Dental Expenses: ~a" linea4)

   ;; Taxes You Paid
   (request "State and local income taxes" linea5)
   (request "Real estate taxes" linea6)
   (request "Personal property taxes" linea7)
   (add (linea5 linea6 linea7) -> linea9)
   (output "Total Taxes You Paid: ~a" linea9)

   ;; Interest You Paid
   (request "Home mortgage interest and points reported to you on Form 1098" linea10)
   (request "Investment interest" linea13)
   (add (linea10 linea13) -> linea14)
   (output "Total Interest You Paid: ~a" linea14)

   ;; Gifts to Charity
   (request "Gifts by cash or check" linea15)
   (request "Other than by cash or check" linea16)
   (request "Carryover from prior year" linea17)
   (add (linea15 linea16 linea17) -> linea18)
   (output "Total Gifts to Charity: ~a" linea18)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;; INTERPRETER ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

#|
Variable Functions
|#
;; A var is (make-var symbol number)
(define-struct var (name val))

;; vars is a list[var]
(define vars empty)

;; lookup-var : symbol -> number
;; produces number associated with given variable name
(define (lookup-var varname)
  (let ([varstructs (filter (lambda (avar) (symbol=? varname (var-name avar))) vars)])
    (cond [(cons? varstructs) (var-val (first varstructs))]
          [else (error 'lookup-var (format "variable ~a not defined" varname))])))

;; update-var : symbol number -> void
;; change value of named var to given number
;; if the specified var doesn't exist, it will be created
(define (update-var varname newval)
  (cond [(empty? (filter (lambda (x) (symbol=? varname (var-name x))) vars))
         (set! vars (cons (make-var varname newval) vars))]
        [else (set! vars
                    (map (lambda (avar)
                           (cond [(symbol=? varname (var-name avar)) (make-var varname newval)]
                                 [else avar]))
                         vars))]))

;--------------------------------------------------------------

;; run-tax-form: tax-form -> void
;; executes the commands in the specified tax-form
(define (run-tax-form a-tax-form)
  (begin
    (run-command-list (tax-form-commands a-tax-form))))
;;(set! vars empty)))

;; run-command-list: list[command] -> void
;; executes all commands in the specified list
(define (run-command-list command-list)
  (for-each run-command command-list))

;; run-command: command -> void
;; executes the specified command
(define (run-command cmd)
  (cond [(output? cmd)
         (print-string (format (output-string cmd) (lookup-var (output-field cmd))))]

        [(display? cmd) (print-string (display-text cmd))]

        [(request-input? cmd)
         (get-user-input (format "~a: " (request-input-text cmd))
                         (request-input-field cmd))]

        [(multiple-choice? cmd)
         (get-user-input (format "~a:~n~a"
                                 (multiple-choice-text cmd)
                                 (create-choices (multiple-choice-choices cmd) 1))
                         (multiple-choice-field cmd))]

        [(yes-no? cmd)
         (begin
           (get-user-input (format "~a (enter yes or no):" (yes-no-text cmd))
                           (yes-no-field cmd))
           (convert-yes-no (yes-no-field cmd)))]

        [(request-list? cmd)
         (begin
           (update-var (request-list-field cmd) empty)
           (handle-request-list (request-list-name cmd)
                                (request-list-questions cmd)
                                (request-list-field cmd)))]

        [(conditional? cmd)
         (cond [(apply (conditional-run? cmd) (map lookup-var (conditional-fields cmd)))
                (run-command (conditional-true-command cmd))]
               [else (run-command (conditional-false-command cmd))])]

        [(compute-field? cmd)
         (update-var (compute-field-field cmd)
                     (apply (compute-field-func cmd) (map lookup-var (compute-field-needed-fields cmd))))]

        [(tax-form? cmd) (run-command-list (tax-form-commands cmd))]

        [(symbol=? cmd 'none) (void)]))

;; get-user-input: string symbol -> void
;; prompts the user for input and stores the result in the specified field
(define (get-user-input prompt field)
  (begin
    (printf prompt)
    (let ([user-input (read)])
      (update-var field user-input))))

;; create-choices: list[string] number -> string
;; generates a string with a numbered list of choices
(check-expect (create-choices empty 1) "")
(check-expect (create-choices '("hi") 1) "1. hi\n")
(check-expect (create-choices '("a" "b" "c") 2) "2. a\n3. b\n4. c\n")

(define (create-choices choices label)
  (cond [(empty? choices) ""]
        [(cons? choices)
         (string-append (format "~a. ~a~n" label (first choices))
                        (create-choices (rest choices) (+ 1 label)))]))

;; handle-request-list: string list[string] symbol -> void
;; repeats a series of questions to the user until the user
;; specifies that they are done
(define (handle-request-list name questions field)
  (begin
    (let ([another (symbol->string (ask-question (format "Do you have another ~a? (enter yes or no)" name)))])
      (cond [(string=? "yes" another)
             (begin
               (update-var field (cons (map ask-question questions) (lookup-var field)))
               (handle-request-list name questions field))]
            [else (void)]))))

;; ask-question: string -> value
;; prompts the user for the answer to the specified question
;; returns the answer to the question
;; since this relies on user input, it can't be tested with check-expect
(define (ask-question question)
  (begin
    (printf "~a: " question)
    (read)))

;; convert-yes-no: symbol -> void
;; converts the value of the specified field from
;; "yes" or "no" to "true" or "false"
(define (convert-yes-no field)
  (let ([ans (lookup-var field)])
    (cond [(symbol=? ans 'yes) (update-var field true)]
          [(symbol=? ans 'no) (update-var field false)])))


;-------------------------------------------------------------

;; print-string : string -> void
;; prints string and a newline to the screen
(define (print-string str)
  (printf "~a~n" str))

;; print-newline : -> void
;; prints a newline on the screen
(define (print-newline) (printf "~n"))

(test)