diff --git a/cl-lazy-parse.asd b/cl-lazy-parse.asd index f604517..7178a0c 100644 --- a/cl-lazy-parse.asd +++ b/cl-lazy-parse.asd @@ -5,9 +5,10 @@ :author "Your Name " :license "Specify license here" :serial t - :depends-on (#:flexi-streams) + :depends-on (#:flexi-streams #:usocket) :components ((:file "package") (:file "queue") + (:file "lazy") (:file "rapid") (:file "cl-lazy-parse"))) diff --git a/cl-lazy-parse.lisp b/cl-lazy-parse.lisp index e6c5930..9e98df8 100644 --- a/cl-lazy-parse.lisp +++ b/cl-lazy-parse.lisp @@ -1,14 +1,5 @@ (in-package #:cl-lazy-parse) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;;;;;;; Basic lazy computation stuff -;;; (avoiding calling them delay/force, because I suspect they ultimately won't be thunks) -(defstruct paused fn) -(defmacro pause (&body body) - `(make-paused :fn (lambda () ,@body))) -(defmethod resume ((p paused)) - (funcall (paused-fn p))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;; Parsers ;;; A parser is a function that might return a result, a +fail+ or a paused state. @@ -142,53 +133,3 @@ Returns the accumulated successes (the empty list, if there were none)." (defmethod char>> ((pred string)) (let ((lst (coerce pred 'list))) (char>> (lambda (c) (member c lst))))) - -(defun space? (c) (eql c #\space)) -(defun non-space? (c) (not (space? c))) -(defun floating? (c) - (let ((code (char-code c))) - (or (= code 46) (>= 57 code 48)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Example -(defparameter *example* "GET /index.html HTTP/1.1 -Host: www.example.com -Content-Length: 38 - -") - -(defparameter +crlf+ (coerce (list #\return #\linefeed) 'string)) - -(defparameter http-method>> - (or>> "GET" "DELETE" "POST" "PUT")) - -(defun to-string (seq) - (coerce seq 'string)) - -(defparameter request-line>> - (with (and>> http-method>> " " (many>> (char>> #'non-space?)) " HTTP/1.1" +crlf+) - (_fn (method _ uri _ _) - (cons (to-string method) (to-string uri))))) - -(defun header-char? (c) - (let ((code (char-code c))) - (or (= code 45) (>= 122 code 65)))) -(defun header-val-char? (c) - (> (char-code c) 13)) - -(defparameter header>> - (with (and>> (many>> (char>> #'header-char?)) ": " (many>> (char>> #'header-val-char?)) +crlf+) - (_fn (k _ v _) - (cons (intern (string-upcase (to-string k)) :keyword) - (to-string v))))) - -(defparameter request>> - (with (and>> request-line>> - (many>> header>>)) - (lambda (req headers) - (format t "~a~%" req) - (format t "~{ ~a~%~}" headers)))) - -(with-input-from-string (s *example*) - (let ((r (rapid s))) - (run! r request>>))) diff --git a/example.lisp b/example.lisp new file mode 100644 index 0000000..3facd63 --- /dev/null +++ b/example.lisp @@ -0,0 +1,99 @@ +(in-package :cl-lazy-parse) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; Example +(defparameter *example* "GET /index.html HTTP/1.1 +Host: www.example.com +Content-Length: 38 + +") + +(defparameter +crlf+ (coerce (list #\return #\linefeed) 'string)) + +(defparameter http-method>> + (or>> "GET" "DELETE" "POST" "PUT")) + +(defun to-string (seq) + (coerce seq 'string)) + +(defun space? (c) (eql c #\space)) +(defun non-space? (c) (not (space? c))) +(defun floating? (c) + (let ((code (char-code c))) + (or (= code 46) (>= 57 code 48)))) + +(defparameter request-line>> + (with (and>> http-method>> " " (many>> (char>> #'non-space?)) " HTTP/1.1" +crlf+) + (_fn (method _ uri _ _) + (format t "Got the request line (~s ~s)...~%" method uri) + (cons (to-string method) (to-string uri))))) + +(defun header-char? (c) + (let ((code (char-code c))) + (or (= code 45) (>= 122 code 65)))) +(defun header-val-char? (c) + (> (char-code c) 13)) + +(defparameter header>> + (with (and>> (many>> (char>> #'header-char?)) ": " (many>> (char>> #'header-val-char?)) +crlf+) + (_fn (k _ v _) + (format t "Got a header (~s ~s)...~%" k v) + (cons (intern (string-upcase (to-string k)) :keyword) + (to-string v))))) + +(defparameter request>> + (with (and>> request-line>> + (many>> header>>)) + (lambda (req headers) + (format t "~a~%" req) + (format t "~{ ~a~%~}" headers)))) + +;; (with-input-from-string (s *example*) +;; (let ((r (rapid s))) +;; (run! r request>>))) + +(defmethod test-server ((port integer) &key (host usocket:*wildcard-host*)) + (let ((server (socket-listen host port :reuse-address t)) + (conns (make-hash-table))) + (unwind-protect + (loop (loop for ready in (wait-for-input (cons server (alexandria:hash-table-keys conns)) :ready-only t) + do (process-ready ready conns))) + (flet ((kill-sock! (sock) + (loop while (socket-close sock)))) + (loop for c being the hash-keys of conns do (kill-sock! c)) + (kill-sock! server))))) + +(defmethod process-ready ((ready stream-server-usocket) (conns hash-table)) + (format t "Got connection...~%") + (let ((client (socket-accept ready))) + (setf (gethash client conns) + (pause + (run! + (rapid (socket-stream client)) + request>>))) + nil)) + +(defmethod process-ready ((ready stream-usocket) (conns hash-table)) + (format t "Processing client...~%") + (let ((res (resume (gethash ready conns)))) + (cond ((paused-p res) + (format t "Still waiting...~%") + (setf (gethash ready conns) res)) + (t + (format t "PARSED!~%~a~%~%" res))))) + +;; (defparameter *sock* (usocket:socket-connect "localhost" 5008)) +;; (write-string "GET /test HTTP/1.1" (socket-stream *sock*)) +;; (write-char #\return (socket-stream *sock*)) +;; (write-char #\linefeed (socket-stream *sock*)) +;; (force-output (socket-stream *sock*)) + +;; (write-string "Host: www.example.com" (socket-stream *sock*)) +;; (write-char #\return (socket-stream *sock*)) +;; (write-char #\linefeed (socket-stream *sock*)) +;; (force-output (socket-stream *sock*)) + +;; (write-string "Content-Type: text/plain" (socket-stream *sock*)) +;; (write-char #\return (socket-stream *sock*)) +;; (write-char #\linefeed (socket-stream *sock*)) +;; (force-output (socket-stream *sock*)) diff --git a/lazy.lisp b/lazy.lisp new file mode 100644 index 0000000..cc29c69 --- /dev/null +++ b/lazy.lisp @@ -0,0 +1,9 @@ +(in-package :cl-lazy-parse) + +;;;;;;;;;; Basic lazy computation stuff +;;; (avoiding calling them delay/force, because I suspect they ultimately won't be thunks) +(defstruct paused fn) +(defmacro pause (&body body) + `(make-paused :fn (lambda () ,@body))) +(defmethod resume ((p paused)) + (funcall (paused-fn p))) diff --git a/package.lisp b/package.lisp index 4b08570..18b2776 100644 --- a/package.lisp +++ b/package.lisp @@ -1,6 +1,6 @@ ;;;; package.lisp (defpackage #:cl-lazy-parse - (:use #:cl) + (:use #:cl #:usocket) (:shadow #:get))