Convert all parseing to use the parser monad.

4 files changed, 89 insertions, 85 deletions

diff --git a/src/org/gnu/clojure/gnunet/crypto.clj b/src/org/gnu/clojure/gnunet/crypto.clj
index ad3e803..a99ccb2 100644
--- a/src/org/gnu/clojure/gnunet/crypto.clj
+++ b/src/org/gnu/clojure/gnunet/crypto.clj
@@ -1,5 +1,6 @@
 (ns org.gnu.clojure.gnunet.crypto
-  (:use (org.gnu.clojure.gnunet message))
+  (:use (org.gnu.clojure.gnunet parser message)
+    clojure.contrib.monads)
   (:import (java.security KeyPairGenerator KeyFactory MessageDigest)
     (java.security.spec RSAKeyGenParameterSpec RSAPublicKeySpec)))
 
@@ -38,13 +39,11 @@
       exponent
       (encode-int16 0))))
 
-(defn decode-rsa-public-key-and-split
-  "Split a seq into an RSA public key and the rest."
-  [a]
-  (let [[len after-len] (decode-uint16-and-split a)
-        [sizen after-sizen] (decode-uint16-and-split after-len)
-        [encoded-n after-n] (split-at sizen after-sizen)
-        [encoded-e after-e] (split-at (- len sizen 4) after-n)
-        [padding after-padding] (decode-uint16-and-split after-e)]
-    [(generate-rsa-public-key (decode-uint encoded-n) (decode-uint encoded-e))
-     after-padding]))
\ No newline at end of file
+(def parse-rsa-public-key
+  (domonad parser-m [len parse-uint16
+                     sizen parse-uint16
+                     encoded-n (items sizen)
+                     encoded-e (items (- len sizen 4))
+                     padding parse-uint16
+                     :when (== padding 0)]
+    (generate-rsa-public-key (decode-uint encoded-n) (decode-uint encoded-e))))
diff --git a/src/org/gnu/clojure/gnunet/hello.clj b/src/org/gnu/clojure/gnunet/hello.clj
index a6f1c33..b50f16e 100644
--- a/src/org/gnu/clojure/gnunet/hello.clj
+++ b/src/org/gnu/clojure/gnunet/hello.clj
@@ -1,45 +1,25 @@
 (ns org.gnu.clojure.gnunet.hello
-  (:use (org.gnu.clojure.gnunet message identity crypto)))
+  (:use (org.gnu.clojure.gnunet parser message identity crypto)
+    clojure.contrib.monads))
 
 (def message-type-hello 16)
 
 (defn encode-transport
   [transport]
   (concat
-    (.getBytes (:name transport) "UTF-8")
-    (list (byte 0))
+    (encode-utf8 (:name transport))
     (encode-int32 (count (:bytes transport)))
-    (encode-int64 (.getTime (:expiration transport)))
+    (encode-date (:expiration transport))
     (:bytes transport)))
 
-(defn decode-transport-and-split
-  [a]
-  (let [[encoded-name after-encoded-name]
-          (split-with (fn [x] (not (== x 0))) a)
-        [term after-term] (split-at-or-throw 1 after-encoded-name)
-        [address-length after-address-length]
-          (decode-uint32-and-split after-term)
-        [expiration after-expiration]
-          (decode-uint64-and-split after-address-length)
-        [encoded-address after-encoded-address]
-          (split-at address-length after-expiration)]
-    [{:name (java.lang.String. (byte-array encoded-name) "UTF-8")
-      :expiration (java.util.Date. expiration)
-      :bytes encoded-address}
-     after-encoded-address]))
-
-(defn many
-  [f a]
-  (loop [result (list)
-         tail a]
-    (try
-      (let [[one after-one] (f tail)]
-        (recur (cons one result) after-one))
-      (catch Exception e [result tail]))))
-
-(defn decode-transports-and-split
-  [a]
-  (many decode-transport-and-split a))
+(def parse-transport
+  (domonad parser-m [name- parse-utf8
+                     address-length parse-uint32
+                     expiration parse-date
+                     encoded-address (items address-length)]
+    {:name name-
+     :expiration expiration
+     :bytes encoded-address}))
 
 (defn encode-hello
   "Encode a hello message."
@@ -49,16 +29,10 @@
     (encode-rsa-public-key (:public-key hello))
     (mapcat encode-transport (:transports hello))))
 
-(defn decode-hello-and-split
-  "Split a seq into a hello and the rest."
-  [a]
-  (let [[padding after-padding] (decode-uint32-and-split a)
-        [public-key after-public-key] (decode-rsa-public-key-and-split
-                                        after-padding)
-        [transports after-transports] (decode-transports-and-split
-                                        after-public-key)]
-    (if (not (== padding 0))
-      (throw (java.lang.Exception. "Must be zero.")))
-    [{:public-key public-key
-      :transports transports}
-     after-transports]))
+(def parse-hello
+  (domonad parser-m [padding parse-uint32
+                     :when (== padding 0)
+                     public-key parse-rsa-public-key
+                     transports (none-or-more parse-transport)]
+    {:public-key public-key
+     :transports transports}))
diff --git a/src/org/gnu/clojure/gnunet/message.clj b/src/org/gnu/clojure/gnunet/message.clj
index 702a3ae..4c74b71 100644
--- a/src/org/gnu/clojure/gnunet/message.clj
+++ b/src/org/gnu/clojure/gnunet/message.clj
@@ -1,5 +1,7 @@
 (ns org.gnu.clojure.gnunet.message
-  (:import java.math.BigInteger))
+  (:use org.gnu.clojure.gnunet.parser
+    clojure.contrib.monads)
+  (:import java.math.BigInteger java.lang.String java.util.Date))
 
 (defn bit-count-to-bytes [x] (quot (+ 7 x) 8))
 
@@ -38,27 +40,33 @@
   [a]
   (BigInteger. 1 (byte-array a)))
 
-(defn split-at-or-throw
-  [n a]
-  (let [[head tail] (split-at n a)]
-    (if (not (== (count head) n))
-      (throw (java.lang.Exception. "Not long enough.")))
-    [head tail]))
+(def parse-uint16
+  (domonad parser-m [xs (items 2)] (int (decode-uint xs))))
 
-(defn decode-uint16-and-split
-  [a]
-  (let [[encoded-int after-encoded-int] (split-at-or-throw 2 a)]
-    [(int (decode-uint encoded-int)) after-encoded-int]))
+(def parse-uint32
+  (domonad parser-m [xs (items 4)] (long (decode-uint xs))))
 
-(defn decode-uint32-and-split
-  [a]
-  (let [[encoded-int after-encoded-int] (split-at-or-throw 4 a)]
-    [(int (decode-uint encoded-int)) after-encoded-int]))
+(def parse-uint64
+  (domonad parser-m [xs (items 8)] (decode-uint xs)))
 
-(defn decode-uint64-and-split
-  [a]
-  (let [[encoded-int after-encoded-int] (split-at-or-throw 8 a)]
-    [(long (decode-uint encoded-int)) after-encoded-int]))
+(defn encode-utf8
+  [string]
+  (concat
+    (.getBytes string "UTF-8")
+    (list (byte 0))))
+
+(def parse-utf8
+  (domonad parser-m [xs (none-or-more (is #(not (== 0 %))))
+                     zero item
+                     :when (== zero 0)]
+    (String. (byte-array xs) "UTF-8")))
+
+(defn encode-date
+  [date]
+  (encode-int64 (.getTime date)))
+
+(def parse-date
+  (domonad parser-m [x parse-uint64] (Date. (long x))))
 
 (defn encode-header
   "Encode a gnunet message header."
@@ -69,17 +77,14 @@
 
 (def header-size (count (encode-header {:size 0 :message-type 0})))
 
-(defn decode-header-and-split
-  "Split a seq into a gnunet message header and the rest."
-  [a]
-  (let [[size after-size] (decode-uint16-and-split a)
-        [message-type after-message-type] (decode-uint16-and-split after-size)]
-    [{:size size
-      :message-type message-type}
-     after-message-type]))
+(def parse-header
+  (domonad parser-m [size parse-uint16
+                     message-type parse-uint16]
+    {:size size
+     :message-type message-type}))
 
 (defn encode-message
   [msg]
   (concat
     (encode-header (+ (count (:bytes msg)) header-size) (:message-type msg))
-    (:bytes msg)))
\ No newline at end of file
+    (:bytes msg)))
diff --git a/src/org/gnu/clojure/gnunet/parser.clj b/src/org/gnu/clojure/gnunet/parser.clj
index c89876a..73ecd86 100644
--- a/src/org/gnu/clojure/gnunet/parser.clj
+++ b/src/org/gnu/clojure/gnunet/parser.clj
@@ -15,4 +15,30 @@
     (m-when (> n 0)
       (domonad [x item
                 xs (items (- n 1))]
-        (cons x xs)))))
\ No newline at end of file
+        (cons x xs)))))
+
+(defn is
+  [p]
+  (domonad parser-m [x item
+                     :when (p x)]
+    x))
+
+(defn optional
+  "Makes a parser optional."
+  [mv]
+  (with-monad parser-m
+    (m-plus mv (m-result nil))))
+
+(def one-or-more)
+
+(defn none-or-more
+  "Makes a parser repeat none or more times."
+  [mv]
+  (optional (one-or-more mv)))
+
+(defn one-or-more
+  "Makes a parser repeat one or more times."
+  [mv]
+  (domonad parser-m [x mv
+                     xs (none-or-more mv)]
+    (cons x xs)))