Move relevant parts to packet.lisp; add arrow-macros

2 files changed, 33 insertions, 24 deletions

diff --git a/src/packet.lisp b/src/packet.lisp
index 12b8926..f66b61c 100644
--- a/src/packet.lisp
+++ b/src/packet.lisp
@@ -1,7 +1,7 @@
 (defpackage :cl-mdns/packet
-  (:use :cl)
+  (:use :cl :arrow-macros)
   (:local-nicknames (:nb :nibbles))
-  (:export :build-query-packet))
+  (:export :build-query-packet :build-response :make-ip-from-string :encode-name :parse-query))
 
 (in-package :cl-mdns/packet)
 
@@ -58,6 +58,13 @@
 (deftype ip-addr-list ()
   '(satisfies ip-addr-list-p))
 
+(defun make-ip-from-string (ip-str)
+  (-<>> (uiop:split-string ip-str :separator ".")
+    (mapcar #'parse-integer)
+    (lambda (x) (if (typep x 'ip-addr-list)
+		    x
+		    (error "~S is not in valid ipv4 format." ip-str)))))
+
 (defun make-ip-body (ip)
   (destructuring-bind (ip-a ip-b ip-c ip-d) ip
     (let ((buffer (make-array 14 :element-type '(unsigned-byte 8) :initial-element 0))
@@ -81,3 +88,26 @@
 	(name (encode-name domain-name))
 	(ip-part (make-ip-body ip)))
     (concatenate '(vector (unsigned-byte 8)) header name ip-part)))
+
+(defun parse-query-body-message (lst)
+  "Parses the body of message.
+The rest of the packet (meaning the tail) is ignored."
+  (labels ((parse-rec (acc rem-lst)
+	     (destructuring-bind (cnt &rest msg) rem-lst
+	       (if (or (null cnt) (zerop cnt))
+		   acc
+		   (parse-rec
+		    (-<>> (subseq msg 0 cnt)
+		      (mapcar #'code-char)
+		      (coerce <> 'string)
+		      list
+		      (concatenate 'list acc))
+		    (nthcdr cnt msg))))))
+    (parse-rec nil lst)))
+
+(defun parse-query (query)
+  "Parses question/query and returns domain name.
+Completely ignores header and tail of packet for now."
+  (let ((message (coerce (subseq query 12) 'list)))
+    (format nil "~{~A~^.~}"
+     (parse-query-body-message message))))
diff --git a/src/publisher.lisp b/src/publisher.lisp
index bcff655..0b3fe86 100644
--- a/src/publisher.lisp
+++ b/src/publisher.lisp
@@ -1,7 +1,6 @@
 ;; Doesn't currently work. I'm unable to join the multicast group to listen for messages.
 (defpackage :cl-mdns/publisher
-  (:use :cl
-	:cl-mdns/packet)
+  (:use :cl :cl-mdns/packet) 
   (:local-nicknames (:nb :nibbles)
                     (:f :fsocket)))
 (in-package :cl-mdns/publisher)
@@ -9,26 +8,6 @@
 (defvar *mdns-address* #(224 0 0 251))
 (defvar *mdns-port* 5353)
 
-; TODO: Bring cl-arrows lib so I can thread expressions
-(defun parse-query-body-message (lst)
-  "Parses the body of message.
-The rest of the packet (meaning the tail) is ignored."
-  (labels ((parse-rec (acc rem-lst)
-	     (destructuring-bind (cnt &rest msg) rem-lst
-	       (if (or (null cnt) (zerop cnt))
-		   acc
-		   (parse-rec
-		    (concatenate 'list acc (list (coerce (map 'list #'code-char (subseq msg 0 cnt)) 'string)))
-		    (nthcdr cnt msg))))))
-    (parse-rec nil lst)))
-
-(defun parse-query (query)
-  "Parses question/query and returns domain name.
-Completely ignores header and tail of packet for now."
-  (let ((message (subseq query 12)))
-    (format nil "~{~A~^.~}"
-     (parse-query-body-message message))))
-
 (defun publish ()
   (f:with-poll (pc)
     (f:with-socket (sock :datagram)