gistfile1.clj

(use '(clojure.contrib monads str-utils))

(defstruct tag :opening :closing)

(def *ansi-html-mapping*
     {;0      close all open tags
       1      (struct tag "<b>" "</b>")
       4      (struct tag "<u>" "</u>")
       5      (struct tag "<blink>" "</blink>")
       7      (struct tag "<i>" "</i>")
       30     (struct tag "<font color=black>" "</font>")
       31     (struct tag "<font color=red>" "</font>")
       32     (struct tag "<font color=green>" "</font>")
       33     (struct tag "<font color=yellow>" "</font>")
       34     (struct tag "<font color=blue>" "</font>")
       35     (struct tag "<font color=purple>" "</font>")
       36     (struct tag "<font color=cyan>" "</font>")
       37     (struct tag "<font color=white>" "</font>") })

(defn extract-ansi-code
 [ansi-sequence]
 (let [[_ code] (re-matches #"\[(\d*)m" ansi-sequence)]
   (try
    (Integer/parseInt code)
    (catch NumberFormatException e
      0))))

(defn transform-ansi-code [code]   
  (domonad state-m
    [:let          [{:keys [opening closing]} 
		    (*ansi-html-mapping* code)]   

     old-state     (fetch-state)
     text          (if (zero? code)
                     (m-result (apply str old-state))
                     (m-result opening))
     _             (set-state (if closing 
                                (conj old-state closing)
                                '()))]
    text))

(defn process-partition
  [mv [text-chunk ansi-seq]]
  (domonad state-m
           [the-chunk (m-result text-chunk)
            v         mv
            text      (if ansi-seq
                        (transform-ansi-code (extract-ansi-code ansi-seq))
                        (m-result ""))]
           (str v the-chunk text)))

(defn split-string [string]
  (partition 2 2 [nil] (re-partition #"\[\d*m" string)))

(defn feed-string [mv string]
  (reduce process-partition mv (split-string string)))

(defn finalize [mv]
  (let [[text leftover] (mv '())]
    (apply str text leftover)))

(defn empty-processor []
  (domonad state-m
           [_ (set-state '())]
           ""))

(finalize (feed-string (empty-processor) "foowhiteboldbar"))

(-> (empty-processor)
    (feed-string "foobar")
    (feed-string "zonk")
    finalize)