Source

monad / src / de / kotka / monad / state.clj

;-
; Copyright 2008 (c) Meikel Brandmeyer.
; All rights reserved.
;
; Permission is hereby granted, free of charge, to any person obtaining a copy
; of this software and associated documentation files (the "Software"), to deal
; in the Software without restriction, including without limitation the rights
; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
; copies of the Software, and to permit persons to whom the Software is
; furnished to do so, subject to the following conditions:
;
; The above copyright notice and this permission notice shall be included in
; all copies or substantial portions of the Software.
;
; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
; THE SOFTWARE.

(clojure.core/ns de.kotka.monad.state
  (:use
     de.kotka.monad
     [clojure.contrib.def :only (defvar)]))

(declare State)

(derive `State `Monad)

(defmethod return `State
  "Sets the value but leaves the state intact."
  [x]
  (make-monad `State #(vector x %)))

(defvar
  get-state
  (make-monad `State #(vector % %))
  "Returns the state as the value.")

(defn put-state
  "Sets the state and a nil value."
  [s]
  (make-monad `State (fn [_] [nil s])))

(defn run-state
  "Apply a state monad to the given initial state. Returns a vector
  consisting of the value and the final state."
  [m s]
  ((monad m) s))

(defvar
  eval-state
  (comp first run-state)
  "Run the given state monad and return its value. Equivalent to run-state
  followed by first.")

(defvar
  exec-state
  (comp second run-state)
  "Run the given state monad and return its final state. Equivalent to
  run-state followed by second.")

(defmethod bind `State
  [m f]
  (make-monad `State
              (fn [s0]
                (let [[a s1] (run-state m s0)]
                  (run-state (f a) s1)))))