1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/contrib/monadic_io_streams.clj	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,145 @@
     1.4 +;; Monadic I/O
     1.5 +
     1.6 +;; by Konrad Hinsen
     1.7 +;; last updated June 24, 2009
     1.8 +
     1.9 +;; Copyright (c) Konrad Hinsen, 2009. All rights reserved.  The use
    1.10 +;; and distribution terms for this software are covered by the Eclipse
    1.11 +;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
    1.12 +;; which can be found in the file epl-v10.html at the root of this
    1.13 +;; distribution.  By using this software in any fashion, you are
    1.14 +;; agreeing to be bound by the terms of this license.  You must not
    1.15 +;; remove this notice, or any other, from this software.
    1.16 +
    1.17 +(ns
    1.18 +  ^{:author "Konrad Hinsen"
    1.19 +     :doc "Monadic I/O with Java input/output streams
    1.20 +           Defines monadic I/O statements to be used in a state monad
    1.21 +           with an input or output stream as the state. The macro
    1.22 +           monadic-io creates a stream, runs a monadic I/O statement
    1.23 +           on it, and closes the stream. This structure permits the
    1.24 +           definition of purely functional compound I/O statements
    1.25 +           which are applied to streams that can never escape from the
    1.26 +           monadic statement sequence."}
    1.27 +  clojure.contrib.monadic-io-streams
    1.28 +  (:refer-clojure :exclude (read-line print println flush))
    1.29 +  (:use [clojure.contrib.monads
    1.30 +	 :only (with-monad domonad state-m state-m-until)])
    1.31 +  (:use [clojure.contrib.generic.functor :only (fmap)])
    1.32 +  (:use [clojure.java.io :only (reader writer)]))
    1.33 +
    1.34 +;
    1.35 +; Wrap the state into a closure to make sure that "evil" code
    1.36 +; can't obtain the stream using fetch-state and manipulate it.
    1.37 +;
    1.38 +(let [key (Object.)
    1.39 +      lock (fn [state] (fn [x] (if (identical? x key) state nil)))
    1.40 +      unlock (fn [state] (state key))]
    1.41 +
    1.42 +  ;
    1.43 +  ; Basic stream I/O statements as provided by Java
    1.44 +  ;
    1.45 +  (defn read-char
    1.46 +    "Read a single character"
    1.47 +    []
    1.48 +    (fn [s] [(.read (unlock s)) s]))
    1.49 +
    1.50 +  (defn read-line
    1.51 +    "Read a single line"
    1.52 +    []
    1.53 +    (fn [s] [(.readLine (unlock s)) s]))
    1.54 +
    1.55 +  (defn skip-chars
    1.56 +    "Skip n characters"
    1.57 +    [n]
    1.58 +    (fn [s] [(.skip (unlock s) n) s]))
    1.59 +
    1.60 +  (defn write
    1.61 +    "Write text (a string)"
    1.62 +    [^String text]
    1.63 +    (fn [s] [(.write (unlock s) text) s]))
    1.64 +
    1.65 +  (defn flush
    1.66 +    "Flush"
    1.67 +    []
    1.68 +    (fn [s] [(.flush (unlock s)) s]))
    1.69 +
    1.70 +  (defn print
    1.71 +    "Print obj"
    1.72 +    [obj]
    1.73 +    (fn [s] [(.print (unlock s) obj) s]))
    1.74 +
    1.75 +  (defn println
    1.76 +    "Print obj followed by a newline"
    1.77 +    ([]
    1.78 +     (fn [s] [(.println (unlock s)) s]))
    1.79 +    ([obj]
    1.80 +     (fn [s] [(.println (unlock s) obj) s])))
    1.81 +
    1.82 +  ;
    1.83 +  ; Inject I/O streams into monadic I/O statements
    1.84 +  ;
    1.85 +  (defn with-reader
    1.86 +    "Create a reader from reader-spec, run the monadic I/O statement
    1.87 +     on it, and close the reader. reader-spec can be any object accepted
    1.88 +     by clojure.contrib.io/reader."
    1.89 +    [reader-spec statement]
    1.90 +    (with-open [r (reader reader-spec)]
    1.91 +      (first (statement (lock r)))))
    1.92 +
    1.93 +  (defn with-writer
    1.94 +    "Create a writer from writer-spec, run the monadic I/O statement
    1.95 +     on it, and close the writer. writer-spec can be any object accepted
    1.96 +     by clojure.contrib.io/writer."
    1.97 +    [writer-spec statement]
    1.98 +    (with-open [w (writer writer-spec)]
    1.99 +      (first (statement (lock w)))))
   1.100 +
   1.101 +  (defn with-io-streams
   1.102 +    "Open one or more streams as specified by io-spec, run a monadic
   1.103 +     I/O statement on them, and close the streams. io-spec is
   1.104 +     a binding-like vector in which each stream is specified by
   1.105 +     three element: a keyword by which the stream can be referred to,
   1.106 +     the stream mode (:read or :write), and a stream specification as
   1.107 +     accepted by clojure.contrib.io/reader (mode :read) or
   1.108 +     clojure.contrib.io/writer (mode :write). The statement
   1.109 +     is run on a state which is a map from keywords to corresponding
   1.110 +     streams. Single-stream monadic I/O statements must be wrapped
   1.111 +     with clojure.contrib.monads/with-state-field."
   1.112 +    [io-specs statement]
   1.113 +    (letfn [(run-io [io-specs state statement]
   1.114 +	      (if (zero? (count io-specs))
   1.115 +		(first (statement state))
   1.116 +		(let [[[key mode stream-spec] & r] io-specs
   1.117 +		      opener (cond (= mode :read) reader
   1.118 +				   (= mode :write) writer
   1.119 +				   :else (throw
   1.120 +					  (Exception.
   1.121 +					   "Mode must be :read or :write")))]
   1.122 +		  (with-open [stream (opener stream-spec)]
   1.123 +		    (run-io r (assoc state key (lock stream)) statement)))))]
   1.124 +      (run-io (partition 3 io-specs) {} statement))))
   1.125 +
   1.126 +;
   1.127 +; Compound I/O statements
   1.128 +;
   1.129 +(with-monad state-m
   1.130 +
   1.131 +  (defn- add-line
   1.132 +    "Read one line and add it to the end of the vector lines. Return
   1.133 +     [lines eof], where eof is an end-of-file flag. The input eof argument
   1.134 +     is not used."
   1.135 +    [[lines eof]]
   1.136 +    (domonad
   1.137 +      [line (read-line)]
   1.138 +      (if (nil? line)
   1.139 +        [lines true]
   1.140 +        [(conj lines line) false])))
   1.141 +
   1.142 +  (defn read-lines
   1.143 +    "Read all lines and return them in a vector"
   1.144 +    []
   1.145 +    (domonad
   1.146 +      [[lines eof] (state-m-until second add-line [[] false])]
   1.147 +      lines)))
   1.148 +