;;; file-project.ss

;;; John David Stone
;;; Department of Mathematics and Computer Science
;;; Grinnell College
;;; stone@math.grin.edu

;;; Original version: January 29 - 31, 1997
;;; Adapted as a project for CSC 151: March 9, 1997

;; My department is currently receiving applications for some teaching
;; positions.  In the past, when trying to compare candidates, we've used
;; worksheets listing their names, affiliations, and specialties, with
;; additional room for comments on each candidate.  The procedures in
;; this library can be used to extract information about each candidate
;; from a file prepared by the department secretary and her assistants
;; and to prepare worksheets and summaries of that information.
;;
;; A candidate's file looks like this (without the comment semicolons at
;; the beginning of each line, of course):
;;
;; : Name
;; : (forenames, surname)
;; Dr. Leslie Applicant
;; : Address
;; Department of Computer Science
;; University of Wherever
;; 1100 Whoozis Boulevard
;; Wherever, NJ  00001
;; : Undergraduate institution
;; School of Hard Knocks
;; : Ph.D.
;; : (institution, actual or projected date)
;; Gizmo University, 1997
;; : Field
;; Isotypical pseudo-equivalence theory
;; : Recent teaching experience (If none, give years as TA)
;; : (institution, began-ended)
;; Adjunct Perfunctor, Replevin College, 1996-1997
;; : Other significant recent job
;; : (employer, title, began-ended)
;; Flautistic Institute, Tutor, 1994-1996
;;
;; In other words, the file consists of a number of what I'll call
;; attributes.  The specification of an attribute begins with a line that
;; starts with a colon; conventionally, this is followed by a space, and
;; then the rest of the line identifies the attribute.

(define attribute-marker #\:)

;; The EXTRACT-ATTRIBUTE-NAME procedure recovers the name of the attribute
;; from a line beginning with ATTRIBUTE-MARKER.  The attribute name starts
;; at position 2, after the colon and a space. 

(define extract-attribute-name
  (lambda (line)
    (substring line 2 (string-length line))))

;; The line immediately following this header may or may not begin with
;; with ATTRIBUTE-MARKER; if it does, it reminds the person who edits
;; the file of the format that is supposed to be used when the value of
;; the attribute is typed in.
;;
;; The lines that begin with ATTRIBUTE-MARKER are part of a fixed
;; template; when the file is created, the first step is to copy in the
;; template, after which only the values need to be entered.  So each file
;; should ideally contain exactly the seven attributes shown in the
;; example.
;;
;; Following the template line or lines, the specification of an attribute
;; continues with one or more lines, not beginning with ATTRIBUTE-MARKER,
;; that give the value of the attribute.
;;
;; Because line breaks are significant in, for instance, a candidate's
;; address, I represent the value of each attribute internally as a list
;; of strings, one for each non-blank line of the value section of the
;; attribute specification.  
;;
;; In practice, the value section of an attribute specification may consist
;; entirely of blank lines.  In such cases, we'll fill in a dummy value for
;; the attribute.  The dummy value is a list of one string, containing no
;; characters. 

(define dummy-attribute-value '(""))

;; We'll represent a candidate as an association list in which the keys
;; are the strings appearing after the ATTRIBUTE-MARKER in the attribute
;; specification header.  Here's a list of those keys:

(define address-key "Address")
(define doctorate-key "Ph.D.")
(define field-key "Field")
(define name-key "Name")
(define other-jobs-key "Other significant recent job")
(define recent-teaching-key
  "Recent teaching experience (If none, give years as TA)")
(define undergraduate-institution-key "Undergraduate institution")

;; The READ-CANDIDATE procedure constructs and returns the association
;; list that represents a candidate, given the name of the file in which
;; the information about that candidate has been stored.  It reads in
;; one attribute specification after another, adding each one to an
;; initially empty association list, until the end of the file is
;; reached.

(define read-candidate
  (lambda (candidate-file-name)
    (let ((source (open-input-file candidate-file-name)))
      (let loop ((candidate '()))
        (discard-unmarked-lines source)
        (if (at-end-of-input? source)
            (begin
              (close-input-port source)
              candidate)
            (loop (cons (read-attribute-specification source)
                        candidate)))))))

;; The DISCARD-UNMARKED-LINES procedure reads in and discards zero or more
;; lines from a specified input port, until it either encounters the end of
;; the input or determines that it is about to read in a line beginning
;; with the ATTRIBUTE-MARKER.

(define discard-unmarked-lines
  (lambda (source)
    (let ((next (peek-char source)))
      (if (and (not (eof-object? next))
               (not (char=? next attribute-marker)))
          (begin
            (discard-line source)
            (discard-unmarked-lines source))))))

;; The DISCARD-LINE procedure reads in and discards a line from a specified
;; input port, including the newline character that terminates it.

(define discard-line
  (lambda (source)

    ;; Write the body of this procedure.  (Hint:  Use READ-CHAR to consume
    ;; characters until you have read either (a) the #\newline character
    ;; or (b) the end-of-file object.)

    ))

;; The AT-END-OF-INPUT? predicate determines whether the last character from
;; a specified input port has been read.

(define at-end-of-input?
  (lambda (source)
    (eof-object? (peek-char source))))

;; The READ-ATTRIBUTE-SPECIFICATION procedure reads in one attribute
;; specification from a specified input port, SOURCE.  It presupposes that
;; a line beginning with the ATTRIBUTE-MARKER has already been located and
;; is about to be read in.  It recovers the name of the attribute from the
;; header, discards any other template lines (also beginning with
;; ATTRIBUTE-MARKER), collects the value of the attribute as a list of
;; strings, and returns the pair consisting of the attribute name and the
;; attribute value. 

(define read-attribute-specification
  (lambda (source)
    (let ((header-line (read-line source)))
      (discard-additional-marked-lines source)
      (cons (extract-attribute-name header-line)
            (read-attribute-value source)))))

;; The READ-LINE procedure reads in and returns a line from a specified
;; input port.  It discards the newline character that terminates the line.
;; If the end-of-file object is encountered before the line terminator is
;; reached, the characters read before the encounter are returned as a
;; string.

(define read-line
  (lambda (source)
    (let loop ((next (peek-char source))
               (char-list '()))
      (cond ((eof-object? next)
             (list->string (reverse char-list)))
            ((char=? next #\newline)
             (read-char source)
             (list->string (reverse char-list)))
            (else
             (read-char source)
             (loop (peek-char source) (cons next char-list)))))))

;; The DISCARD-ADDITIONAL-MARKED-LINES procedure reads in and discards zero
;; or more lines from the specified input port until it either encounters
;; the end of the input or determines that it is about to read in a line
;; not beginning with the ATTRIBUTE-MARKER.

(define discard-additional-marked-lines
  (lambda (source)
    (let ((next (peek-char source)))
      (if (and (not (eof-object? next))
               (char=? next attribute-marker))
          (begin
            (discard-line source)
            (discard-additional-marked-lines source))))))

;; The READ-ATTRIBUTE-VALUE procedure collects an attribute value, a line
;; at a time, from a specified input port.  It discards any lines
;; consisting entirely of spaces (including lines of length 0).  If there
;; are no non-blank lines in the value, the procedure returns
;; DUMMY-ATTRIBUTE-VALUE.

(define read-attribute-value
  (lambda (source)
    (let loop ((next (peek-char source))
               (result '()))
      (if (or (eof-object? next)
              (char=? next attribute-marker))
          (if (null? result)
              dummy-attribute-value
              (reverse result))
          (let ((line (read-line source)))
            (loop (peek-char source)
                  (if (empty-line? line)
                      result
                      (cons line result))))))))

;; The EMPTY-LINE? predicate determines whether a given string consists
;; entirely of zero or more spaces, returning #T if it does and #F if it
;; does not.

(define empty-line?
  (lambda (str)
    (let ((len (string-length str)))
      (let loop ((index 0))
        (or (= index len)
            (and (char=? (string-ref str index) #\space)
                 (loop (+ index 1))))))))

;; The WRITE-WORKSHEET procedure creates a worksheet that includes all the
;; information about selected candidates.  It prints an appropriate header,
;; loops through the roster of candidates and writes a horizontal rule and
;; a worksheet entry for each one, and finally prints a double horizontal
;; rule (a row of equals signs) at the bottom

(define write-worksheet
  (lambda (worksheet-file-name candidate-roster)
    (let ((print-width 80))    ; A sheet of paper is eighty columns wide.
      (let ((target (open-output-file worksheet-file-name))
            (rule (make-string print-width #\-))
            (double-rule (make-string print-width #\=)))

        ; Print the header.
        
        (display "Candidate worksheet" target)
        (newline target)
        (display "Generated automatically by file-project.ss" target)
        (newline target)

        ; Proceed to the candidates.

        (let loop ((rest candidate-roster))
          (if (null? rest)
              (begin
                (display double-rule target)
                (newline target)
                (close-output-port target))
              (begin
                (display rule target)
                (newline target)
                (write-candidate (read-candidate (car rest)) target)
                (leave-space-for-comments target)
                (loop (cdr rest)))))))))

;; The WRITE-CANDIDATE procedure writes out, to a specified output port,
;; the worksheet entry for one candidate.  Here is how it is supposed to
;; look, in the case of the imaginary candidate described above:
;;
;; Dr. Leslie Applicant
;; Department of Computer Science
;; University of Wherever
;; 1100 Whoozis Boulevard
;; Wherever, NJ  00001
;;
;; Doctorate: Gizmo University, 1997.
;; Undergraduate degree: School of Hard Knocks.
;; Current position: Adjunct Perfunctor, Replevin College, 1996-1997.
;; Previous position(s): Flautistic Institute, Tutor, 1994-1996.
;; Field: Isotypical pseudo-equivalence theory
;;
;; The procedure is pretty simple -- just write out all the surrounding
;; text and drop the non-dummy attribute values in at the correct points.

(define write-candidate
  (lambda (candidate target)
    (newline target)

    (display (car (lookup-attribute name-key candidate)) target)
    (newline target)

    (display-each-line (lookup-attribute address-key candidate) target)
    (newline target)

    (display "Doctorate: " target)
    (display (car (lookup-attribute doctorate-key candidate)) target)
    (display "." target)
    (newline target)

    (display "Undergraduate degree: " target)
    (display (car (lookup-attribute undergraduate-institution-key
                                    candidate))
             target) 
    (display "." target)
    (newline target)

    (display "Current position: " target)
    (display (car (lookup-attribute recent-teaching-key candidate)) target)
    (display "." target)
    (newline target)

    (display "Previous position(s): " target)
    (let loop ((rest (lookup-attribute other-jobs-key candidate)))
      (if (not (null? rest))
          (begin
            (display (car rest) target)
            (display (if (null? (cdr rest)) "." ";") target)
            (newline target)
            (loop (cdr rest)))))

    (display "Field: " target)
    (display (car (lookup-attribute field-key candidate)) target)
    (display "." target)
    (newline target)

    (newline target)))

;; The LOOKUP-ATTRIBUTE function recovers and returns the value of a
;; specified attribute from a given candidate (i.e., association list),
;; but it returns DUMMY-ATTRIBUTE-VALUE if the attribute is not found.

(define lookup-attribute
  (lambda (key alist)
    (let ((entry-for-attribute (assoc key alist)))
      (if entry-for-attribute
          (cdr entry-for-attribute)
          dummy-attribute-value))))

;; The DISPLAY-EACH-LINE procedure takes two arguments, the first a list
;; of values to be written out and the second an output port to receive
;; those values, and writes out each value on a line of its own.

(define display-each-line
  (lambda (list-of-values target)
    (if (not (null? list-of-values))
        (begin
          (display (car list-of-values) target)
          (newline target)
          (display-each-line (cdr list-of-values) target)))))

;; The LEAVE-SPACE-FOR-COMMENTS procedure prints a few empty lines below
;; the data for each candidate, so that someone reviewing the candidate's
;; credentials has enough room to summarize other relevant information.

(define leave-space-for-comments
  (lambda (target)
    (newline target)
    (newline target)
    (newline target)
    (newline target)
    (newline target)
    (newline target)))

;; Here is a list of names for files containing made-up candidate data, for
;; you to experiment with.

(define candidate-roster
  (list "Applicant.cand" "Frenoolian.cand" "Spelvin.cand"))

;; The call (write-worksheet "worksheet.txt" candidate-roster) should
;; create the file worksheet.txt with entries for each of these three
;; candidates.