;; Caltech CS1 Fall 2007
;; Scheme code used in Lecture 15 (11/19/2007)
;; mvanier@cs.caltech.edu
;; Originally by Ben Brantley.
;; Page 1 of 4.

;; First pass at a limited cs1man implementation:

(define (make-cs1man-v0.0)

  ;; some internal "private" data...
  (let ((students (list)))     ;; a list of valid accounts
    
    ;; internal helper predicate to determine whether a student exists
    (define (is-student? name)
      (list? (memq name students)))
    
    ;; the anonymous (unnamed) message-processing lambda
    (lambda (op . args)
      (cond        
        ;; add a new account to cs1man
        ((eq? op 'add-student!) 
         (set! students (cons (car args) students)))
        
        ;; return the list of all accounts in cs1man
        ((eq? op 'get-students)
         students)
        
        ;; return #t if first argument matches a known account name
        ((eq? op 'is-student?)
         (is-student? (car args)))))))
  
;; Some simple operations on version 0.0:
(define cs1-2007 (make-cs1man-v0.0))
(cs1-2007 'add-student! 'donnie)
(cs1-2007 'get-students)
(cs1-2007 'add-student! 'joseph)
(cs1-2007 'is-student? 'mike)
(cs1-2007 'get-students)


;; Page 2 of 4.
;; Version 0.1 adds 'submit message.

(define (make-cs1man-v0.1)

  ;; a helper object to represent assignment submissions
  (define (make-submission name assignment text)
    (lambda (op . args)
      (cond ((eq? op 'get-name)       name)
            ((eq? op 'get-assignment) assignment)
            ((eq? op 'get-text)       text)
            (else (error "unknown op:" op)))))
  
  ;; some internal "private" data...
  (let ((students    (list))   ;; a list of valid accounts
        (submissions (list)))  ;; a list of all submissions
    
    ;; internal helper predicate to determine whether a student exists
    (define (is-student? name)
      (list? (memq name students)))

    ;; the anonymous (unnamed) message-processing lambda
    (lambda (op . args)
      (cond 
       ;; add a new account to cs1man
       ((eq? op 'add-student!) 
        (set! students (cons (car args) students)))
       
       ;; return the list of all accounts in cs1man
       ((eq? op 'get-students)
        students)
       
       ;; return #t if first argument matches a known account name
       ((eq? op 'is-student?)
        (is-student? (car args)))
       
       ;; accept a submission for a given account name, submission name.
       ;; the body of the submission, as a text string, should be in 
       ;; argument 3.
       ((eq? op 'submit)
        (let ((name       (car args))
              (assignment (cadr args))
              (text       (caddr args)))
          (if (not (is-student? name))
              (error "unknown student: " name)
              (set! submissions 
                    (cons (make-submission name assignment text) 
                          submissions)))))))))  
  
(define cs1-2007 (make-cs1man-v0.1))
(cs1-2007 'add-student! 'donnie)
(cs1-2007 'submit 'donnie 'lab1 "hello")
(cs1-2007 'add-student! 'joseph)
(cs1-2007 'submit 'joseph 'lab1 "hi there")
(cs1-2007 'submit 'joseph 'lab2 "number 2")


;; Page 3 of 4.
;; Version 0.2 includes the ability to 'unsubmit (retrieve a lab).
(define (make-cs1man-v0.2)
  ;; a helper object to represent assignment submissions
  (define (make-submission name assignment text)
    (lambda (op . args)
      (cond ((eq? op 'get-name)       name)
            ((eq? op 'get-assignment) assignment)
            ((eq? op 'get-text)       text)
            (else (error "unknown op:" op)))))
  ;; some internal "private" data...
  (let ((students (list))      ;; a list of valid accounts
        (submissions (list)))  ;; a list of all submissions
    ;; internal helper predicate to determine whether a student exists
    (define (is-student? name)
      (list? (memq name students)))
    
    ;; Internal helper function to locate a submission within the list.  
    ;; Walks through the list and finds the first submission that matches
    ;; a given account and assignment name.
    (define (find-submission name assignment)
      (define (find-submission-aux rest)
        (if (null? rest) (list)
            (let ((next-submission (car rest)))
              (if (and (eq? (next-submission 'get-name) name)
                       (eq? (next-submission 'get-assignment) assignment))
                  next-submission  ;; found it!  return it.
                  (find-submission-aux (cdr rest))))))
      (find-submission-aux submissions))
    
    ;; the anonymous (unnamed) message-processing lambda
    (lambda (op . args)
      (cond 
       ;; add a new account to cs1man
       ((eq? op 'add-student!) 
        (set! students (cons (car args) students)))
       
       ;; return the list of all accounts in cs1man
       ((eq? op 'get-students)
        students)
       
       ;; return #t if first argument matches a known account name
       ((eq? op 'is-student?)
        (is-student? (car args)))
       
       ;; accept a submission for a given account name, submission name.
       ;; the body of the submission, as a text string, should be in 
       ;; argument 3.
       ((eq? op 'submit)
        (let ((name       (car args))
              (assignment (cadr args))
              (text       (caddr args)))
          (if (not (is-student? name))
              (error "unknown student: " name)
              (set! submissions 
                    (cons (make-submission name assignment text) 
                          submissions)))))

;; Page 4 of 4.
;; Continuing with the example...

       ;; extract a submission for a given account name and submission name.
       ((eq? op 'unsubmit)
        (let ((name       (car args))
              (assignment (cadr args)))
          (if (not (is-student? name))
              (error "unknown student: " name)
              (let ((submission (find-submission name assignment)))
                (if (null? submission) 
                    (error "no lab submitted for: " name)
                    (submission 'get-text))))))))))
  
  
(define cs1-2007 (make-cs1man-v0.2))
(cs1-2007 'add-student! 'donnie)
(cs1-2007 'submit 'donnie 'lab1 "hello")
(cs1-2007 'add-student! 'joseph)
(cs1-2007 'submit 'joseph 'lab1 "hi there")
(cs1-2007 'unsubmit 'donnie 'lab1)
;; ==> "hello"