;; The first three lines of this file were inserted by DrScheme. They record metadata
;; about the language level of this file in a form that our tools can easily process.
#reader(lib "htdp-intermediate-lambda-reader.ss" "lang")((modname xml) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ())))
;;
;;*********************************************************
;;
;; CS135 Assignment 10, Question 1
;; Amir Sayed Khader, 20348702
;; (operations with xml files)
;;
;;
;;*********************************************************
;;
(define-struct stag (name attrs))
(define-struct etag (name))
;; An attribute is of the form (list n t), where n and t are strings.
;; A start-tag is (make-stag n a), where n in a string and a is a
;; (listof attribute).
;; An end-tag is (make-etag n), where n is a string.
;; A tag is a start-tag or an end-tag.
;; An Example token
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Basic helper functions to extract tokens from a list of characters,
;; inspired by the code on Slides 35 and 36 of Module 10.
;;
;; get-token-until: (char -> boolean) (listof char) -> (listof char)
;; Produce the prefix of the passed-in list of characters consisting
;; of all characters up to but not including the first one which
;; satisfies the predicate break?. Assume that we will find a
;; character that satisfies the predicate before we run out of list.
;; Examples:
(check-expect (get-token-until char-alphabetic? '(#\a #\1 #\2)) empty)
(check-expect (get-token-until char-alphabetic? '(#\1 #\a #\b #\2 #\3 #\4)) '(#\1))
(define (get-token-until break? a-chl)
(cond
[(break? (first a-chl)) empty]
[else (cons (first a-chl) (get-token-until break? (rest a-chl)))]))
;; Tests:
(check-expect (get-token-until char-alphabetic? '(#\1 #\2 #\a #\b #\3 #\4 #\c)) '(#\1 #\2))
;; remove-token-while: (char -> boolean) (listof char) -> (listof char)
;; Produce the suffix of the passed-in list consisting of all
;; characters beginning with the first one which does not satisfy
;; the predicate while?. (This is slightly different from
;; remove-token in the notes, which produces the suffix starting
;; *after* the first character that satisfies the predicate.)
;; Examples:
(check-expect (remove-token-while char-alphabetic? '(#\a #\1 #\2)) '(#\1 #\2))
(check-expect (remove-token-while char-alphabetic? '(#\1 #\a)) '(#\1 #\a))
(define (remove-token-while while? a-chl)
(cond
[(empty? a-chl) empty]
[(while? (first a-chl)) (remove-token-while while? (rest a-chl))]
[else a-chl]))
; Tests:
(check-expect (remove-token-while char-alphabetic? '(#\a #\b #\c #\1 #\d #\2)) '(#\1 #\d #\2))
(check-expect (remove-token-while char-alphabetic? '(#\a #\b #\c)) empty)
;; parse-tag-loc: (listof char) -> tag
;; Purpose: To consume a list of characters that contains a single xml
;; star or end tag and return the corresponding tag value
;; Examples
(check-expect (parse-tag-loc '(#\< #\i #\m #\g #\space #\s #\r #\c #\=
#\" #\h #\i #\. #\j #\p #\g #\"
#\> ))
(make-stag "img" (list (list "src" "hi.jpg"))))
(define (parse-tag-loc token)
(local
;;format-tag: (listof char) -> (listof char)
;; Purpose: to consume a token (with a single xml tag within it
;; and return the xml tag properly formated according
;; to the following standards:
;; 1 - starts with #\< and ends with #\>
;; 2 - only single spaces seperating the tag name,
;; and attributes
;; 3 - no spaces between attribute names and values
;; Examples
;;(check-expect (format-tag '(#\< #\space #\space #\space #\h #\space #\a #\> #\space #\space #\a))
;; '(#\< #\h #\space #\a #\>))
;;(check-expect (format-tag '(#\< #\space #\h #\e #\l #\l #\o #\space #\m #\y #\space #\= #\space
;; #\n #\e #\w #\> #\space))
;; '(#\< #\h #\e #\l #\l #\o #\space #\m #\y #\= #\n #\e #\w #\>))
[(define (format-tag token)
(cond [(and (char=? (first token) #\space)
(char=? (first (rest token)) #\>))
(cons #\> empty)]
[(char=? (first token) #\<) (cons #\< (format-tag (remove-token-while
(lambda (x)
(cond [(char=? #\space x) true]
[else false]))
(rest token))))]
[(char=? (first token) #\>) (cons #\> empty)]
[(and (char=? (first token) #\space)
(char=? (second token) #\=))
(cons #\= (format-tag (remove-token-while
(lambda (x)
(cond [(char=? #\space x) true]
[else false]))
(rest (rest token)))))]
[(char=? (first token) #\space)
(cons #\space (format-tag (remove-token-while (lambda (x)
(cond [(char=? #\space x) true]
[else false]))
token)))]
[else (cons (first token) (format-tag (rest token)))]))
;; test cases
;;(check-expect (format-tag '(#\< #\space #\i #\m #\g #\space
;; #\space #\s #\r #\c #\= #\space
;; #\" #\a #\i #\. #\j #\p #\g #\" #\>))
;; '(#\< #\i #\m #\g #\space #\s #\r #\c #\= #\" #\a #\i
;; #\. #\j #\p #\g #\" #\>))
;; tag-title: (listof char) -> (listof (union string char))
;; Purpose: To consume a tag and return the title of the tag
;; if the tag is an end-tag, return a leading '/'
;; (check-expect (tag-title '(#\< #\/ #\i #\m #\g #\>))
;; (list "/img" #\>))
;; (check-expect (tag-title '(#\< #\s #\r #\c #\space
;; #\a #\b #\>))
;; (list "src" #\space #\a #\b #\>))
(define (tag-title token)
(cond [(char=? (first token) #\<)
(cons
(list->string (get-token-until (lambda (x)
(cond [(or (char=? #\space x)
(char=? #\> x)) true]
[else false]))
(rest token)))
(remove-token-while (lambda (x)
(cond [(not (or (char=? #\space x)
(char=? #\> x))) true]
[else false]))
token))]))
;; get-attrib: (listof char) -> (listof (union string char))
;; Purpose: To consume a tag whose title has already been removed
;; and return a list in which the first element is of the form
;; (list a b) where a is an attribute and b is the corresponding value
;; , and the rest of the list is what is left of the token after the
;; attribute-value pair has been removed
;; Examples
;; (check-expect (get-attrib '(#\h #\e #\a #\= #\" #\s #\h
;; #\a #\" #\>))
;; (list (list "hea" "sha") #\>))
;; (check-expect (get-attrib '(#\i #\m #\g #\= #\" #\1 #\. #\j #\p
;; #\g #\" #\space #\a #\b #\c #\>))
;; (list (list "img" "1.jpg") #\space #\a #\b #\c #\>))
(define (get-attrib token)
(cons (assign-attrib (get-token-until (lambda (x)
(cond [(or (char=? x #\space)
(char=? x #\>)) true]
[else false]))
token))
(remove-token-while (lambda (x)
(cond [(not (or (char=? x #\space)
(char=? x #\>))) true]
[else false]))
token)))
(define (assign-attrib attribs)
(cond [(char=? (first attribs) #\=)
(cons (list->string (get-token-until
(lambda (x)
(cond [(or (char=? x #\space)
(char=? x #\")) true]
[else false]))
(rest (rest attribs)))) empty)]
[else (cons (list->string (get-token-until
(lambda (x)
(cond [(char=? x #\=) true]
[else false]))
attribs))
(assign-attrib (remove-token-while
(lambda (x)
(cond [(not (char=? x #\=)) true]
[else false]))
attribs)))]))]
;; End of local definitions
(cond [(char=? (first token) #\>) empty]
[(char=? (first token) #\<)
(cond [(char=? (first (string->list (first (tag-title (format-tag token))))) #\/)
(make-etag (list->string (rest (string->list (first (tag-title (format-tag token)))))))]
[else (make-stag (first (tag-title (format-tag token)))
(parse-tag-loc (rest (tag-title (format-tag token)))))])]
[(char=? (first token) #\space) (parse-tag-loc (rest token))]
[else (cons (first (get-attrib token)) (parse-tag-loc (rest (get-attrib token))))]
)
))
;; Test cases
;; Test for a single end tag
(check-expect (parse-tag-loc '(#\< #\/ #\i #\m #\g #\>))
(make-etag "img"))
;; Test for a start tag with no attributes
(check-expect (parse-tag-loc '(#\< #\s #\r #\c #\>))
(make-stag "src" empty))
; parse-tag: string -> tag
;; Consume the first XML tag found in the input string and return it
;; as a tag according to the data definition above.
;; Examples:
(check-expect (parse-tag " <a b = \"c\" d=\"e\" >") (make-stag "a" '(("b" "c") ("d" "e"))))
(check-expect (parse-tag "</xml>") (make-etag "xml"))
(define (parse-tag s)
(parse-tag-loc (string->list s)))
;; Tests:
;; Examples suffice for this wrapper function. You'll need more in-depth
;; tests for parse-tag-loc.